#!/usr/bin/perl
##---------------------------------------------------------------------------##
## File:
## @(#) ProcessRepeats
## Authors:
## Arian Smit <asmit@systemsbiology.org>
## Robert Hubley <rhubley@systemsbiology.org>
## original ExtractObjects module by Chris Abadjian
## and Todd Smith.
## Description:
## Takes RepeatMasker output and produces an annotation table.
##
##
#******************************************************************************
#*
#* Copyright (C) Institute for Systems Biology 2002-2008 Developed by
#* Arian Smit and Robert Hubley.
#*
#* Copyright (C) Arian Smit 2000-2001
#*
#* Copyright (C) University of Washington 1996-1999 Developed by Arian Smit,
#* Philip Green and Colin Wilson of the University of Washington Department of
#* Genomics.
#*
#* This work is licensed under the Open Source License v2.1. To view a copy
#* of this license, visit http://www.opensource.org/licenses/osl-2.1.php or
#* see the license.txt file contained in this distribution.
#*
###############################################################################
# ChangeLog
#
# $Log: ProcessRepeats,v $
# Revision 1.211 2011/04/26 22:41:44 rhubley
# Cleanup before a distribution
#
#
###############################################################################
#
#
=head1 NAME
ProcessRepeats - Post process results from RepeatMasker and produce an annotation file.
=head1 SYNOPSIS
ProcessRepeats [-options] <RepeatMasker *.cat file>
=head1 DESCRIPTION
The options are:
=over 4
=item -h(elp)
Detailed help
=item -species <query species>
Post process RepeatMasker results run on sequence from
this species. Default is human.
=item -lib <libfile>
Skips most processing, does not produce a .tbl file unless
the custome library is in the ">name#class" format.
=item -nolow
Does not display simple repeats or low_complexity DNA in the annotation.
=item -noint
Skips steps specific to interspersed repeats, saving lots of time.
=item -lcambig
Outputs ambiguous DNA transposon fragments using a lower case
name. All other repeats are listed in upper case. Ambiguous
fragments match multiple repeat elements and can only be
called based on flanking repeat information.
=item -u
Creates an untouched annotation file besides the manipulated file.
=item -xm
Creates an additional output file in cross_match format (for parsing).
=item -ace
Creates an additional output file in ACeDB format.
=item -gff
Creates an additional Gene Feature Finding format.
=item -poly
Creates an output file listing only potentially polymorphic simple repeats.
=item -no_id
Leaves out final column with unique number for each element (was default).
=item -excln
Calculates repeat densities excluding long stretches of Ns in the query.
=item -orf2
Results in sometimes negative coordinates for L1 elements; all L1 subfamilies
are aligned over the ORF2 region, sometimes improving interpretation of data.
=item -a
Shows the alignments in a .align output file.
=item -maskSource <originalSeqenceFile>
Instructs ProcessRepeats to mask the sequence file using the annotation.
=item -x
Mask repeats with a lower case 'x'.
=item -xsmall
Mask repeats by making the sequence lowercase.
=back
=head1 SEE ALSO
=over 4
RepeatMasker, Crossmatch, Blast
=back
=head1 COPYRIGHT
Copyright 2008 Arian Smit, Institute for Systems Biology
=head1 AUTHORS
Arian Smit <asmit@systemsbiology.org>
Robert Hubley <rhubley@systemsbiology.org>
=cut
#
# Module Dependence
#
use strict;
use FindBin;
use lib $FindBin::RealBin;
use SeqDBI;
use RepeatAnnotationData;
use FileHandle;
use FastaDB;
use SearchResult;
use SearchEngineI;
use SearchResultCollection;
use ArrayList;
use CrossmatchSearchEngine;
use Getopt::Long;
use Taxonomy;
use Data::Dumper;
# Global variables
my $DEBUG = 0;
my $DIRECTORY = "$FindBin::Bin";
#
# Refinement Hash:
# Contains re-alignments for *.cat alignments which were refined.
# structure is as follows:
# $refinementHash{ "b#s#i#" }->{ ConsensusID } = ( annot1ref, annot2ref, ...)
#
my %refinementHash = (); # Contains refined annotations ordered by catID
my %chainSeq1Length;
# A bug in 5.8 produces way too many warnings
if ( $] && $] >= 5.008003 ) {
use warnings;
}
#
# Option processing
# e.g.
# -t: Single letter binary option
# -t=s: String parameters
# -t=i: Number paramters
#
my @opts =
qw (a ace debug excln gff lib=s noint nolow orf2 orifile=s no_id poly species=s u xm mammal mus rat rod|rodent cow pig artiodactyl cat dog carnivore chicken fugu danio drosophila elegans arabidopsis rice wheat maize primate maskSource=s xsmall x lcambig source html refcat=s );
#
# Get the supplied command line options, and set flags
#
my %options = ();
unless ( &GetOptions( \%options, @opts ) ) {
exec "pod2text $0";
exit( 0 );
}
## Print the internal POD documentation if something is missing
if ( $#ARGV == -1 && !$options{'help'} ) {
print "No cat file indicated\n\n";
# This is a nifty trick so we don't have to have
# a duplicate "USAGE()" subroutine. Instead we
# just recycle our POD docs. See PERL POD for more
# details.
exec "pod2text $0";
die;
}
##
## Species Options and Taxonomy Processing
##
## NOTE: Tax needs to be global for the moment
my $tax;
if ( $options{'species'} ) {
# Need to set opt_species, opt_mammal, opt_mus
$tax = Taxonomy->new( taxonomyDataFile => "$DIRECTORY/taxonomy.dat" );
if ( $tax->isA( $options{'species'}, "primates" ) ) {
$options{'primate'} = 1;
}
elsif ( $tax->isA( $options{'species'}, "rodentia" ) ) {
$options{'mus'} = 1;
}
elsif ( $tax->isA( $options{'species'}, "mammalia" ) ) {
$options{'mammal'} = 1;
}
if ( $tax->isA( $options{'species'}, "metatheria" ) ) {
$options{'marsupial'} = 1;
}
}
else {
$options{'species'} = "homo";
$options{'primate'} = 1;
}
# warning for debug mode
print "Note that in debug mode the IDs are not adjusted to go up stepwise\n\n"
if $options{'debug'};
#
# Check library type used
#
# TODO: We need different levels of meta data compliance. Ie.
# Pound formatting isn't enough anymore. Also we can glean
# compliance like pound formatting from the cat file. No
# need to open up the lib ( yet ).
my $poundformat = "";
if ( $options{'lib'} ) {
open( IN, $options{'lib'} );
while ( <IN> ) {
if ( /^>\S+\#\S+/ ) {
$poundformat = 1;
# Assuming that this represents my classification formatting; no sure
# thing could make it more restrictive by also requiring a backslash
last;
}
}
}
else {
$poundformat = 1;
}
#
# Loop over input files
#
foreach my $file ( @ARGV ) {
open( INCAT, $file ) || die "Can\'t open file $file\n";
# INITIALIZE CAT FILE DATA
# Read the cat file and calculate:
# - The length of the original sequence ( minus 1/2 of the overlap )
# - The number of N bases
# - The number of sequences
# - The length of each sequence
# - The fraction GC the version the masked length and the dbversion.
# Also...grab batch overlap boundaries if information is present.
my %batchOverlapBoundaries = ();
my $numSearchedSeqs = 0;
my $lenSearchedSeqs = 0;
my $lenSearchedSeqsExcludingXNRuns = 0;
my $lenSearchedSeqsExcludingAmbig = 0;
my $versionmode = "";
my $engine = "";
my $dbversion = "";
while ( <INCAT> ) {
if ( /^##\s*(\S+)\s+([\d\s,]+)/ ) {
$batchOverlapBoundaries{$1} = [ sort( split( /,/, $2 ) ) ];
}
elsif ( /^##\s*Total\s+Sequences:\s*(\d+)/i ) {
$numSearchedSeqs = $1;
}
elsif ( /^##\s*Total\s+Length:\s*(\d+)/i ) {
$lenSearchedSeqs = $1;
}
elsif ( /^##\s*Total\s+NonMask.*:\s*(\d+)/i ) {
$lenSearchedSeqsExcludingXNRuns = $1;
}
elsif ( /^##\s*Total\s+NonSub.*:\s*(\d+)/i ) {
$lenSearchedSeqsExcludingAmbig = $1;
}
elsif ( /^RepeatMasker|run|RepBase/ ) {
my @bit = split;
$versionmode = $_ if $bit[ 0 ] eq 'RepeatMasker';
$engine = $1 if /^(run with.*)/;
if ( /^(RepBase.*)/ ) {
$dbversion = $1;
last;
}
}
}
close INCAT;
#
# Parse the cat file into an object
#
my $sortedAnnotationsList = undef;
if ( $options{'a'} ) {
$sortedAnnotationsList = &parseCATFile( file => $file );
}
else {
$sortedAnnotationsList = &parseCATFile( file => $file, noAlignData => 1 );
}
#
# Read in the refined annotations
#
my $refinedAnnots = undef;
if ( -f $options{'refcat'} ) {
$refinedAnnots = &parseCATFile( file => $options{'refcat'} );
my $refinedIter = $refinedAnnots->getIterator();
while ( $refinedIter->hasNext() ) {
my $currentAnnot = $refinedIter->next();
# Consider moving this to CATID
my $catID = $currentAnnot->getLastField();
$catID =~ s/[\[\]]//g;
push @{ $refinementHash{$catID}->{ $currentAnnot->getHitName() } },
( $currentAnnot );
}
}
# Create some filename constants
my $catfile = $file;
$file =~ s/\.(temp)?cat$//;
my $filename = $file;
$filename =~ s/(.*\/)//;
unless ( $sortedAnnotationsList->size() > 0 ) {
my $filenaam = $file;
$filenaam = $options{'orifile'} if $options{'orifile'};
open( OUT, ">$file.out" );
print STDERR "\n\n\nNo repetitive sequences were detected in $filenaam\n";
print OUT "There were no repetitive sequences detected in $filenaam\n";
close( OUT );
next;
}
print STDERR "processing output: ";
open( OUTRAW, ">$file.ori.out" ) if ( $options{'u'} || !$poundformat );
#
# Initialize data structures and ID each annotation
#
# Makes global %seq1Lengths
# NOTE: Only needed because we are not updating LeftOver
# when we modify Seq1Beg/End
#
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
my $cycleAnnotIter = $sortedAnnotationsList->getIterator();
my $i = -1;
my %seq1Lengths = ();
while ( $cycleAnnotIter->hasNext() ) {
$i++;
my $currentAnnot = $cycleAnnotIter->next();
# Do this early so we capture all information before it is changed.
# NOTE: I may make derived elements links to the cat file for
# memory brevity.
if ( $options{'source'} ) {
$currentAnnot->addDerivedFromAnnot( $currentAnnot );
$currentAnnot->setAlignData( undef );
}
my $HitName = $currentAnnot->getHitName();
$HitName =~ s/_short_$//;
$currentAnnot->setHitName( $HitName );
if ( !defined $seq1Lengths{ $currentAnnot->getSeq1Name() }
|| $seq1Lengths{ $currentAnnot->getSeq1Name() } <
( $currentAnnot->getSeq1End() + $currentAnnot->getLeftOver() ) )
{
$seq1Lengths{ $currentAnnot->getSeq1Name() } =
$currentAnnot->getSeq1End() + $currentAnnot->getLeftOver();
}
}
print STDERR "\ncycle 1 ";
#printHitArrayList( $sortedAnnotationsList );
my ( $chainBegRef, $chainEndRef ) = &cycleReJoin( $sortedAnnotationsList );
my %chainBeg = %{$chainBegRef};
my %chainEnd = %{$chainEndRef};
########################## C Y C L E 2 ###############################
# Purpose: Remove Edge Effect Annotations
# Join Poly-A Tails
# Reconstruct Satellite Annotations
##########################################################################
print STDERR "\ncycle 2 ";
# Sort by name, begin position, and end position descending
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
# Create an ArrayListIterator for this cycle
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
my %colWidths = &getMaxColWidths( $sortedAnnotationsList );
my $DEBUG = 0;
$i = -1;
CYCLE2:
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
# NOTE: An iterator's index is considered
# to be in between elements of a datastructure.
# To obtain the correct index for the
# current element in this pass we should
# get the index *before* we move the iterator.
my $currentIndex = $cycleAnnotIter->getIndex();
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "CYCLE2: Considering\n";
$currentAnnot->print();
}
if ( $currentAnnot->getRightLinkedHit() ) {
my $proxIter = $cycleAnnotIter->getIterator();
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
# Quit once we reach our partner
last if ( $nextAnnot == $currentAnnot->getRightLinkedHit() );
# Break Recursion Violations
if ( $currentAnnot->containsElement( $nextAnnot )
&& $nextAnnot->containsElement( $currentAnnot->getRightLinkedHit() ) )
{
if ( $DEBUG ) {
print STDERR "This violates recursion:\nFirst:\n";
$currentAnnot->printLeftRightLinks();
print STDERR "Second:\n";
$nextAnnot->printLeftRightLinks();
}
# Break lower scoring link
my $oldRight = $nextAnnot->getRightLinkedHit();
$nextAnnot->setRightLinkedHit( undef );
$oldRight->setLeftLinkedHit( undef );
}
}
}
##
## Edge Effect Removal
##
## The current method of processing overlaps, while better
## than before still produces some edge effects. This
## section attempts to remove these before we start any
## serious analysis.
##
## Overlaps are handled in RepeatMasker thus:
##
## Middle
## <------ |
## ----->
## Batch#1 | ----x---->
## ...-----------------------------|
## |
## |
## |-----------------------------...
## | BATCH#2
## <-x- |
## ---->
## | ---------------->
##
##
## RepeatMasker deletes all annotations which are
## contained in the region left/right ( closest to
## the edge ) of the overlap midpoint. Shown here
## with an "x" in the diagram annotations.
## If an annotation spans the midpoint it is kept
## in the cat file. This leaves several types of
## edge effects in annoation:
##
## Perfect or Near Perfect duplicates. Perfect if
## the same matrix was used and the annotation is
## completely contained in the overlap. Near perfect
## otherwise.
##
## Middle
## |
## ----->
## |
## ----->
##
##
## Cut Level Ambiguities. A full length young repeat
## partially contained in the overlap will be excised
## at a lower cutlevel in one batch and masked at
## a higher cutlevel in the other batch. See below
## for some examples.
##
##
# Remove exact duplicates. Near duplicates get resolved elsewhere
# ( FuseOverlappingSeqs etc ). We do this now especially to handle
# duplicated poly-a tails that we are about to join.
my $prevAnnot = $sortedAnnotationsList->get( $currentIndex - 1 )
if ( $currentIndex > 0 );
if ( $prevAnnot
&& $currentAnnot->getSW() == $prevAnnot->getSW()
&& $currentAnnot->getPctSubst() == $prevAnnot->getPctSubst()
&& $currentAnnot->getSeq1Name() eq $prevAnnot->getSeq1Name()
&& $currentAnnot->getSeq1Beg() == $prevAnnot->getSeq1Beg()
&& $currentAnnot->getSeq1End() == $prevAnnot->getSeq1End() )
{
# Lower Scoring Overlap > %90 Covered by Higher Scoring
# Get rid of lower scoring one
# same cutlevel
if ( $DEBUG ) {
print STDERR "REMOVING EXACT DUPLICATE:\n";
$currentAnnot->print();
print STDERR " because of:\n";
$prevAnnot->print();
}
#$prevAnnot->addDerivedFromAnnot( $currentAnnot )
# if ( $options{'source'} );
# Fix any previous joins to this element
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
next CYCLE2;
}
#
# If a large >1000bp ( 1/2 current overlap distance )
# young repeat starts outside the overlap and spans
# the middle of the overlap you will get edge effect
# duplications. I.e.
#
# Case #1 Middle
# batch1 |
# ---------------------------|
# -----------------> ( excised cutlevels 0-4 )
# ----X----> ( masked cutlevel 5 )
# |------------------------------
# | batch2
# |
# or |
# batch1 ----X--> ( masked cutlevel 5 )
# ----------------------------|
# |------------------------------- batch2
# -----------------> ( excised cutlevel 0-4 )
# |
#
# Because excision is only performed on full length
# elements (lines can be 5' truncated) this can be
# detected by checking for elements which contained by
# a cutlevel 5 annotation *and* are less than cutlevel 5.
#
# Case #2 Middle
# |
# <---X--- ( cut level 5..just outside the other )
# ----------------------------|
# |-------------------------------
# | <---------- (excised cut level 0-4 )
# |
# |
# Case #3 |
# (c.l. 5) --> |
# -------> ( c.l. 3 )
# -----------------------------|
# |----------------------------
# X> |
# -------->
#
# In this case you have a cut level 3 spaning a middle
# which is one bp longer in one batch. This creates
# a 1bp overlap with a something at a higher cut level.
#
# So our general rule ends up: Remove all elements
# in cutlevels 4/5 which overlap ( by > 10bp ) or are
# contained by another element at a lessor cut level.
# These cases should never occur outside the overlap
# region anyway.
#
if ( $currentAnnot->getLastField >= 4 ) {
my $proxIter = $cycleAnnotIter->getIterator();
$proxIter->previous();
while ( $proxIter->hasPrevious() ) {
my $prevAnnot = $proxIter->previous();
last
unless ( $currentAnnot->getSeq1Name eq $prevAnnot->getSeq1Name()
&& $prevAnnot->getSeq1End() >= $currentAnnot->getSeq1Beg() );
if ( $prevAnnot->getLastField() < $currentAnnot->getLastField
&& $prevAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() >= 10 )
{
if ( $DEBUG ) {
print STDERR "DELETING MASKED INSIDE CUT:\n";
$currentAnnot->print();
print STDERR " because of previous:\n";
$prevAnnot->print();
}
#$prevAnnot->addDerivedFromAnnot( $currentAnnot )
# if ( $options{'source'} );
# Fix any previous joins to this element
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
next CYCLE2;
}
}
$proxIter = $cycleAnnotIter->getIterator();
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
last
unless ( $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $nextAnnot->getSeq1Beg() <= $currentAnnot->getSeq1End() );
if ( $nextAnnot->getLastField() < $currentAnnot->getLastField
&& $currentAnnot->getSeq1End() - $nextAnnot->getSeq1Beg() >= 10 )
{
if ( $DEBUG ) {
print STDERR "DELETING MASKED INSIDE CUT:\n";
$currentAnnot->print();
print STDERR " because of next:\n";
$nextAnnot->print();
}
#$nextAnnot->addDerivedFromAnnot( $currentAnnot )
# if ( $options{'source'} );
# Fix any previous joins to this element
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
next CYCLE2;
}
}
}
#
# Masklevel Violations From Clipping Boundaries
#
# RepeatMasker fragments alignments which span
# cut out elements. This fragmentation process may
# convert a pair of alignments like:
#
# --------------^-------------> SW=1000
# -----------^-----------------> SW=1500
#
# ( where "^" marks the site of a clipped out element )
# into something like:
#
# SW = 1000 SW = 1000
# --------------> ------------->
# -----------> ----------------->
# SW = 1500 SW = 1500
#
# This little block of code resolves this masklevel
# rule-breaker ( lower scoring alignment contained by
# higher scoring one ) by elminating the lower scoring
# subfragments.
#
# i.e Delete element if flanking elements include
# it and has a better or equal score.
#
# SW = 1000
# -------------->
# -----------> ----------------->
# SW = 1500 SW = 1500
#
# This is still a bit artificial.
#
$prevAnnot = $sortedAnnotationsList->get( $currentIndex - 1 )
if ( $currentIndex > 0 );
my $proxIter = $cycleAnnotIter->getIterator();
my ( $prevHitName, $prevClassName ) =
split( /\#/, $prevAnnot->getSeq2Name() )
if ( $prevAnnot );
#
# Delete iff:
# ----current-----^ SW <= past
# -----past-------^
# -..----past----------^
#
# or
# ^---current----- SW <= past
# ^----past-------
# ^------past----------...--
#
if (
$prevAnnot
&& (
(
$currentAnnot->getSeq1End() == $prevAnnot->getSeq1End()
&& $currentAnnot->getSW() <= $prevAnnot->getSW()
&& $currentAnnot->getSeq1Name() eq $prevAnnot->getSeq1Name()
&& $currentAnnot->getClassName() eq $prevClassName
)
|| ( $currentAnnot->getSeq1Beg() == $prevAnnot->getSeq1Beg()
&& $currentAnnot->getSeq1End() <= $prevAnnot->getSeq1End()
&& $currentAnnot->getSW() <= $prevAnnot->getSW()
&& $currentAnnot->getSeq1Name() eq $prevAnnot->getSeq1Name()
&& $currentAnnot->getClassName() eq $prevClassName )
)
)
{
if ( $DEBUG ) {
print STDERR "Deleting clipping boundary fragment "
. "( masklevel violation ):\n";
$prevAnnot->print();
$currentAnnot->print();
}
#$prevAnnot->addDerivedFromAnnot( $currentAnnot )
# if ( $options{'source'} );
# Fix any previous joins to this element
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
next CYCLE2;
}
my $Seq2BeginPrint = $currentAnnot->getSeq2Beg();
my $LeftUnalignedPrint = "(" . $currentAnnot->get3PrimeUnaligned() . ")";
my $LeftOverPrint = "(" . $currentAnnot->getLeftOver() . ")";
if ( $currentAnnot->getRevComp() eq "C" ) {
$Seq2BeginPrint = "(" . $currentAnnot->get3PrimeUnaligned() . ")";
$LeftUnalignedPrint = $currentAnnot->getSeq2Beg();
}
#
# Supposedly creates an untouched annotation file.
# What it really does is create an annotation file
# which has been modified to remove exact duplicates
# and batch overlap artifacts only.
#
if ( $options{'u'} || !$poundformat ) {
my $prevAnnot = $sortedAnnotationsList->get( $currentIndex - 1 )
if ( $currentIndex > 0 );
my $nextAnnot = $sortedAnnotationsList->get( $currentIndex + 1 )
if ( $currentIndex < $sortedAnnotationsList->size() - 1 );
my $Overlapped = "";
if ( $prevAnnot
&& $currentAnnot->getSeq1Beg() <= $prevAnnot->getSeq1End()
&& $currentAnnot->getSW() < $prevAnnot->getSW()
|| $nextAnnot
&& $currentAnnot->getSeq1End() >= $nextAnnot->getSeq1Beg()
&& $currentAnnot->getSW() < $nextAnnot->getSW() )
{
$Overlapped = "*";
}
$currentAnnot->setClassName( "" )
unless ( $currentAnnot->getClassName() );
#
# sequence names get truncated to 20 letters. Too
# cumbersome to change. However, names like
# /mnt/user/users/FlipvanTiel/mystuff/sequence1 better be
# clipped from the end. Thus:
$currentAnnot->setSeq1Name( substr( $currentAnnot->getSeq1Name(), -20 ) )
if ( length $currentAnnot->getSeq1Name() > 20
&& $currentAnnot->getSeq1Name() =~ /^\// );
printf OUTRAW "%6d %4s %4s %4s %20s %9s %9s %8s %1s "
. "%20s %15s %7s %7s %7s %3s\n", $currentAnnot->getSW(),
$currentAnnot->getPctSubst, $currentAnnot->getPctDelete,
$currentAnnot->getPctInsert, $currentAnnot->getSeq1Name(),
$currentAnnot->getSeq1Beg(), $currentAnnot->getSeq1End(),
"(" . $currentAnnot->getLeftOver() . ")", $currentAnnot->getRevComp(),
$currentAnnot->getHitName(), $currentAnnot->getClassName(),
$Seq2BeginPrint, $currentAnnot->getSeq2End(), $LeftUnalignedPrint;
$Overlapped;
} # if ( $options{'u'} || !$poundformat )
#
# If a user supplied non-classified library was used
#
if ( !$poundformat ) {
if ( $options{'ace'} ) {
if ( $currentAnnot->getRevComp() eq "C" ) {
print OUTACE "Motif_homol \""
. $currentAnnot->getHitName()
. "\" \"RepeatMasker\" "
. $currentAnnot->getPctSubst() . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " - "
. $currentAnnot->getSeq2End() . " "
. $currentAnnot->getSeq2Beg() . "\n";
}
else {
print OUTACE "Motif_homol \""
. $currentAnnot->getHitName()
. "\" \"RepeatMasker\" "
. $currentAnnot->getPctSubst() . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " + "
. $currentAnnot->getSeq2Beg() . " "
. $currentAnnot->getSeq2End() . "\n";
}
}
if ( $options{'xm'} ) {
my $tempclassname = "";
$tempclassname = "\#" . $currentAnnot->getClassName()
if ( $currentAnnot->getClassName() );
print OUTXM $currentAnnot->getSW() . " "
. $currentAnnot->getPctSubst() . " "
. $currentAnnot->getPctDelete() . " "
. $currentAnnot->getPctInsert() . " "
. $currentAnnot->getSeq1Name() . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " "
. $LeftOverPrint . " "
. $currentAnnot->getRevComp() . " "
. $currentAnnot->getHitName()
. $tempclassname . " "
. $Seq2BeginPrint . " "
. $currentAnnot->getSeq2End() . " "
. $LeftUnalignedPrint . "\n";
}
if ( $options{'gff'} ) {
my $source;
if ( $currentAnnot->getHitName() =~ /Alu/ ) {
$source = 'RepeatMasker_SINE';
}
else { #
$source = 'RepeatMasker';
}
print OUTGFF ""
. $currentAnnot->getSeq1Name()
. "\t$source\tsimilarity\t"
. $currentAnnot->getSeq1Beg() . "\t"
. $currentAnnot->getSeq1End() . "\t"
. $currentAnnot->getPctSubst() . "\t"
. ( $currentAnnot->getRevComp() eq 'C' ? '-' : '+' ) . "\t.\t"
. "Target \"Motif:"
. $currentAnnot->getHitName() . "\" "
. $currentAnnot->getSeq2Beg() . " "
. $currentAnnot->getSeq2End() . "\n";
}
} # if ( !$poundformat )
else {
#
# Satellite Consensi
# Searching for satellites with consensi is a hack.
# Search engines such as crossmatch will often return
# hits to a single repeating pattern as:
# | | | | |
# abcdefghabcdefghabcdefghabcdefghabcdefgh
# --------->
# -------->
# -------->
# By creating a consensus for the repeat pattern and
# another for the same pattern shifted by 1/2 of the
# cycle. You can nicely overlapping hits.
# These shifted consensi are denoted by the use of a
# trailing "_" in the name.
#
# Here is the regular expression for the syntax:
#
# [A-Z_]+[a-z]?_?#Satellite
#
# So here are some examples:
#
# ALR_#Satellite
# ALRa#Satellite
# ALRa_#Satellite
# CENSAT_MC#Satellite
#
# Since these trailing "_" variants and the "[a-z]"
# variants are equivalent we only need to restore
# the original name by stripping these characters
# HitName.
#
# NOTE: The lowercase varieties are not in repbase.
#
if ( $currentAnnot->getClassName =~ /Satellite/ ) {
my $HitName = $currentAnnot->getHitName();
$HitName =~ s/_$//;
$HitName =~ s/[a-z]$//;
$currentAnnot->setHitName( $HitName );
}
if ( $currentAnnot->getClassName =~ /DNA/ ) {
# Find all ambiguous dna transposon fragments and generate
# equivalency lists
&preProcessDNATransp( \%chainBeg, \%chainEnd, $currentAnnot,
\%RepeatAnnotationData::repeatDB );
}
}
} # END CYCLE 2
close( OUTRAW ) if ( $options{'u'} || !$poundformat );
#
# If we do not have a pound formatted database we are done!
#
if ( !$poundformat ) {
&generateOutput(
\%options, \%seq1Lengths,
$file, $filename,
$dbversion, $numSearchedSeqs,
$lenSearchedSeqs, $lenSearchedSeqsExcludingXNRuns,
$versionmode, $engine,
$sortedAnnotationsList, $poundformat
);
}
else {
# Continue with the rest of the cycles!
########################## C Y C L E 3 ################################
#
# This cycle is currently handling the de-fragmentation
# of DNA Transposons using a new method. It also joins simple
# repeats together.
#
# Creates global %conPosCorrection
########################################################################
#printHitArrayList( $sortedAnnotationsList );
# Sort by name, begin position, and end position descending
print STDERR "\ncycle 3 ";
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
$i = -1;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$DEBUG = 0;
my %conPosCorrection = ();
CYCLE3:
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
# NOTE: An iterator's index is considered
# to be in between elements of a datastructure.
# To obtain the correct index for the
# current element in this pass we should
# get the index *before* we move the iterator.
my $currentIndex = $cycleAnnotIter->getIndex();
my $currentAnnot = $cycleAnnotIter->next();
if ( $currentAnnot->getStatus() eq "DELETED" ) {
# NOTE: Annotation already added to derived list.
# Fix any previous joins to this element
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
next CYCLE3;
}
if ( $DEBUG ) {
print STDERR "Considering:\n";
$currentAnnot->print();
}
if ( $currentAnnot->getClassName() =~ /DNA/
&& $currentAnnot->getStatus() ne "JOINED" )
{
#if ( $DEBUG ) {
#print STDERR "DNA Transposon Equivalent:\n";
#print STDERR Dumper( $EquivHash ) . "\n";
#}
# Look into our future
my $proxIter = $cycleAnnotIter->getIterator();
my @dnaTransposonCluster = ();
my $elementDistance = 0;
my $ignoreUntil = undef;
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
my ( $nextHitName, $nextClassName ) =
split( /\#/, $nextAnnot->getSeq2Name() );
if ( $DEBUG ) {
print STDERR " -vs-: ";
$nextAnnot->print();
}
$elementDistance++ if ( $nextClassName =~ /DNA/ );
#
# Reasons we wouldn't consider this element in our cluster and
# trigger the end to the search
#
# TODO: Do not join fragments outside of a parent fragment.
#
last
if (
$currentAnnot->getSeq1Name() ne $nextAnnot->getSeq1Name()
|| $elementDistance > 20
|| $nextAnnot->getSeq1End() - $currentAnnot->getSeq1End() >
15000 # max retrovirus insert
|| $nextAnnot->containsElement( $currentAnnot )
);
if ( $ignoreUntil ) {
if ( $ignoreUntil == $nextAnnot ) {
$ignoreUntil = undef;
}
next;
}
if ( $nextClassName =~ /DNA/
&& $nextAnnot->getStatus() ne "JOINED"
&& $nextAnnot->getStatus() ne "DELETED" )
{
push @dnaTransposonCluster, $nextAnnot;
}
if ( $nextAnnot->getRightLinkedHit() ) {
$ignoreUntil = $nextAnnot->getRightLinkedHit();
}
}
if ( @dnaTransposonCluster ) {
# Consider recruiting putative related elements to our cause
&joinDNATransposonFragments(
\%chainBeg,
\%chainEnd,
\%RepeatAnnotationData::repeatDB,
$currentAnnot,
\@dnaTransposonCluster
);
}
# printHitArrayList( $sortedAnnotationsList );
}
if ( $currentAnnot->getHitName =~ /^MLT2/ )
{ # middle region of MLT2 variable in length in subfamilies
# NOTE: Initializes conPosCorrection{ID} for LTRs
&preProcessLTR( \%chainBeg, \%chainEnd,
\%conPosCorrection, $currentAnnot );
}
elsif ( $currentAnnot->getClassName =~ /LINE/ ) {
# I placed this here because I could.
# adjust start position of LINE termini and
# give generic names to too precisely categorized LINEs
# NOTE: Initializes conPosCorrection{ID} for LINEs
&preProcessLINE( \%chainBeg, \%chainEnd,
\%conPosCorrection, $currentAnnot );
}
# merge long simple repeats which were initially partly spliced out
# Note that not all satellite entries represent (multiple)
# units. Some are complex sequences that can contain
# minisatellites in it; overlapping matches to such
# subsequences cause 'funny' annotation (in particular,
# the location of the match in the consensus sequence is off)
if ( $currentAnnot->getClassName() =~ /Simple|Satellite/ ) {
if ( $cycleAnnotIter->hasNext() ) {
#
# current ..-----------
# next ..-----
#
my $proxIter = $cycleAnnotIter->getIterator();
my $nextAnnot = $proxIter->next();
if ( $currentAnnot->getSeq1Name() eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getRevComp() eq $nextAnnot->getRevComp()
&& $currentAnnot->getSeq1End() > $nextAnnot->getSeq1End() )
{
my $tempname = quotemeta $currentAnnot->getHitName();
if ( $nextAnnot->getSeq2Name() =~ /tempname/ ) {
my $thislength =
$currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() + 1;
my $nextlength =
$nextAnnot->getSeq2End() - $nextAnnot->getSeq2Beg() + 1;
my $Seq2Length = $thislength + $nextlength;
my $SW = $nextAnnot->getSW()
if ( $nextAnnot->getSW() > $currentAnnot->getSW() );
$currentAnnot->setSW( $SW );
$currentAnnot->setPctSubst(
(
$currentAnnot->getPctSubst() * $thislength +
$nextAnnot->getPctSubst() * $nextlength
) / $Seq2Length
);
$currentAnnot->setPctDelete(
(
$currentAnnot->getPctDelete() * $thislength +
$nextAnnot->getPctDelete() * $nextlength
) / $Seq2Length
);
$currentAnnot->setPctInsert(
(
$currentAnnot->getPctInsert() * $thislength +
$nextAnnot->getPctInsert() * $nextlength
) / $Seq2Length
);
$nextAnnot->removeFromJoins();
$currentAnnot->addDerivedFromAnnot( $nextAnnot )
if ( $options{'source'} );
$proxIter->remove();
}
}
} # if ( $cycleAnnotIter->hasNext()...
#
if ( $currentAnnot->getClassName() =~ /Simple/ ) {
# Requirement added in January 2005; Satellites should not
# be considered This loop will convert all to forward
# orientation. The annotation shows then the inverse
# complement unit of simple repeats, but such is not
# available for satellites.
if (
(
$currentAnnot->getPctSubst() + $currentAnnot->getPctDelete() +
$currentAnnot->getPctInsert()
) > 15
)
{
if ( $currentAnnot->getHitName() =~ /AAA|\(A\)/ ) {
if ( $currentAnnot->getRevComp() eq '+' ) {
$currentAnnot->setHitName( "A-rich" );
}
else {
$currentAnnot->setHitName( "T-rich" );
}
}
elsif ( $currentAnnot->getHitName() =~ /GGG|\(G\)/ ) {
if ( $currentAnnot->getRevComp() eq '+' ) {
$currentAnnot->setHitName( "G-rich" );
}
else {
$currentAnnot->setHitName( "C-rich" );
}
}
if ( $currentAnnot->getHitName() =~ /\([GA]+\)/ ) {
if (
$currentAnnot->getSW() < (
$currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() + 1
) * (
9 - $currentAnnot->getPctSubst() * 16 / 100 - (
$currentAnnot->getPctDelete() +
$currentAnnot->getPctInsert()
) * 23 / 100
)
)
{
if ( $currentAnnot->getRevComp() eq '+' ) {
$currentAnnot->setHitName( "GA-rich" );
}
else {
$currentAnnot->setHitName( "CT-rich" );
}
}
else {
if ( $currentAnnot->getRevComp() eq '+' ) {
$currentAnnot->setHitName( "polypurine" );
}
else {
$currentAnnot->setHitName( "polypyrimidine" );
}
}
}
}
if ( $currentAnnot->getHitName() =~ /^\(/ ) {
my $unit = $currentAnnot->getHitName();
$unit =~ s/\((\w+)\)n/$1/;
my $merness = length $unit;
if ( $currentAnnot->getRevComp() eq "C" ) {
unless ( $currentAnnot->getHitName() =~
/\(TA\)|\(TTAA\)|\(CG\)|\(CCGG\)/ )
{
$unit = reverse $unit;
$unit =~ tr/ACGT/TGCA/;
$currentAnnot->setHitName( "($unit)n" );
}
}
while ( $currentAnnot->getSeq2Beg() > $merness ) {
$currentAnnot->setSeq2Beg(
$currentAnnot->getSeq2Beg() - $merness );
$currentAnnot->setSeq2End(
$currentAnnot->getSeq2End() - $merness );
}
}
$currentAnnot->setRevComp( "+" );
$currentAnnot->set3PrimeUnaligned( 0 );
}
}
if ( $currentAnnot->getClassName() eq "Low_complexity" ) {
# AT-rich and GC rich not strand specific
$currentAnnot->setRevComp( '+' );
$currentAnnot->setSeq2End(
$currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() + 1 );
$currentAnnot->setSeq2Beg( 1 );
$currentAnnot->set3PrimeUnaligned( 0 );
}
}
########################## C Y C L E 4 ################################
#
# Join Overlapping Fragments
#
########################################################################
#printHitArrayList( $sortedAnnotationsList );
# Sort by name, begin position, and end position descending
print STDERR "\ncycle 4 ";
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
$i = -1;
##
## This "joins" overlapping fragments for all types of
## annotations. This in effect replaces the FuseOverlappingSeqs sub.
##
##
$DEBUG = 0;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
my $prevAnnot;
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "Overlapping Fragments Considering:\n";
$currentAnnot->printBrief();
}
next if ( $currentAnnot->getClassName() =~ /Simple|Low/ );
my $nextAnnot;
my $proxIter = $cycleAnnotIter->getIterator();
my @joinList = ();
my $currentEnd = $currentAnnot->getSeq1End();
my $skipUntil = undef;
while ( $proxIter->hasNext() ) {
$nextAnnot = $proxIter->next();
if ( $DEBUG ) {
print STDERR " -vs-> (qo = "
. $currentAnnot->getQueryOverlap( $nextAnnot ) . "): ";
$nextAnnot->printBrief();
}
# Quit once we reach our partner
last
if (
(
$currentAnnot->getRightLinkedHit()
&& $nextAnnot == $currentAnnot->getRightLinkedHit()
)
|| ( !$currentAnnot->getRightLinkedHit()
&& $currentEnd < $nextAnnot->getSeq1Beg() )
|| $currentAnnot->getSeq1Name() ne $nextAnnot->getSeq1Name()
);
# ASSERT: No more recursion violations
if ( $currentAnnot->getRightLinkedHit()
&& $currentAnnot->containsElement( $nextAnnot )
&& $nextAnnot->containsElement( $currentAnnot->getRightLinkedHit() ) )
{
## Currently DNA Transposons can violate recursion rules.
if ( $DEBUG ) {
print STDERR "\n\n\nThis violates recursion:\nFirst:\n";
$currentAnnot->printLeftRightLinks();
print STDERR "Second:\n";
$nextAnnot->printLeftRightLinks();
print STDERR "\n\n\n";
die;
}
}
if ( $skipUntil ) {
if ( $skipUntil == $nextAnnot ) {
$skipUntil = undef;
}
else {
print STDERR " -- Can't consider...inside existing join\n"
if ( $DEBUG );
next;
}
}
#
# Join Overlapping Elements
#
# TODO: We join things that perhaps we shouldn't. This is a proposed
# change to the joining mechanism. Need to consider the change
# from 33 to 50 architectually before we continue with this.
#
# Query Overlap > 50
# ConsensusOverlap - QueryOverlap < 200
# if (
# (
# $currentEnd - $nextAnnot->getSeq1Beg() > 50
# || ( $currentAnnot->getQueryOverlap( $nextAnnot ) ==
# ( $nextAnnot->getSeq1End() - $nextAnnot->getSeq1Beg() + 1 ) )
# )
# && $currentAnnot->getRightLinkedHit() != $nextAnnot
# && $currentAnnot->getRightLinkedHit() != $currentAnnot
# && $currentAnnot->getClassName() eq $nextAnnot->getClassName()
# && $currentAnnot->getRevComp() eq $nextAnnot->getRevComp()
# && ( $currentAnnot->getConsensusOverlap( $nextAnnot ) -
# $currentAnnot->getQueryOverlap( $nextAnnot ) ) < 200
# )
if (
(
$currentEnd - $nextAnnot->getSeq1Beg() > 33
|| ( $currentAnnot->getQueryOverlap( $nextAnnot ) ==
( $nextAnnot->getSeq1End() - $nextAnnot->getSeq1Beg() + 1 ) )
)
&& $currentAnnot->getRightLinkedHit() != $nextAnnot
&& $currentAnnot->getRightLinkedHit() != $currentAnnot
&& $currentAnnot->getClassName() eq $nextAnnot->getClassName()
&& $currentAnnot->getRevComp() eq $nextAnnot->getRevComp()
)
{
if ( $DEBUG ) {
print STDERR " Adding to overlap element cluster (co="
. $currentAnnot->getConsensusOverlap( $nextAnnot ) . ")\n";
}
push @joinList, $nextAnnot;
$currentEnd = $nextAnnot->getSeq1End()
if ( $currentEnd < $nextAnnot->getSeq1End() );
}
elsif ( $nextAnnot->getRightLinkedHit() ) {
$skipUntil = $nextAnnot->getRightLinkedHit();
}
} # while has next
if ( @joinList ) {
my $leftSide = $currentAnnot;
my $equivHash = {};
if ( $DEBUG ) {
print STDERR " Joining overlap cluster ---- :\n";
print STDERR " ";
$leftSide->printBrief();
}
foreach my $partner ( @joinList ) {
if ( $DEBUG ) {
print STDERR " ";
$partner->printBrief();
}
$leftSide->join( $partner );
# Don't ambiguate the name unless the overlap is excessive
# or the element is subsummed completely by the other.
if ( $leftSide->getQueryOverlap( $partner ) > 50
|| $leftSide->getSeq1End() >= $partner->getSeq1End() )
{
print STDERR " ls = "
. $leftSide->getSeq2Name()
. " par = "
. $partner->getSeq2Name() . "\n"
if ( $DEBUG );
$equivHash->{ $leftSide->getSeq2Name() } = 1;
$equivHash->{ $partner->getSeq2Name() } = 1;
}
$leftSide = $partner;
}
if ( keys( %{$equivHash} ) ) {
foreach my $element ( @joinList, $currentAnnot ) {
my $newEquivHash = { %{$equivHash} };
if ( defined $equivHash->{ $element->getSeq2Name() } ) {
delete $newEquivHash->{ $element->getSeq2Name() };
}
$element->setEquivHash( $newEquivHash );
}
}
}
}
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 5 ################################
#
# This cycle is currently handling the de-fragmentation
# of SINES using a new method.
#
########################################################################
#printHitArrayList( $sortedAnnotationsList );
# Sort by name, begin position, and end position descending
print STDERR "\ncycle 5 ";
if ( $options{'refcat'} ) {
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
$i = -1;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$DEBUG = 0;
my %conPosCorrection = ();
## Create a cycle data structure to hold last 21 join scores.
## ie. prevScoreHash{ ID }->{ HitName } = chainScore ( sum of score function )
my %prevScoreHash = ();
CYCLE5:
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
# NOTE: An iterator's index is considered
# to be in between elements of a datastructure.
# To obtain the correct index for the
# current element in this pass we should
# get the index *before* we move the iterator.
my $currentIndex = $cycleAnnotIter->getIndex();
my $currentAnnot = $cycleAnnotIter->next();
my ( $currentHitName, $currentClassName ) =
split( /\#/, $currentAnnot->getSeq2Name() );
if ( $DEBUG ) {
print STDERR "Considering:\n";
$currentAnnot->print();
if ( $currentAnnot->getRightLinkedHit() ) {
print STDERR "Bummer this already is linked forward to:\n ";
$currentAnnot->getRightLinkedHit()->print();
}
}
#
# Find first fragment which is capable of joining to the right:
#
#
# ----seed----> ------>
# or
# <----+
# |
# ----seed----> ------>
#
# NOTE: Currently I am using a non-empty $refinementHash as a
# proxy for $currentAnnot->isRefineable()
#
if ( defined $refinementHash{ $currentAnnot->getCATID() }
&& keys %{ $refinementHash{ $currentAnnot->getCATID() } }
&& !$currentAnnot->getRightLinkedHit() )
{
if ( $DEBUG ) {
print STDERR "First Candidate Seed:\n ";
$currentAnnot->print();
}
#
# Gather a collection of candidates
#
my @candidateJoins = ();
my $proxIter = $cycleAnnotIter->getIterator();
my $elementDistance = 0;
my $ignoreUntil = undef;
my $lastAnnot = $currentAnnot;
my $lastDivAnnot = undef;
my $classElementDistance = 0;
my $totElementDistance = 0;
my $highestInterveningDiv = 0;
my $unAnnotatedBP = 0;
my $unAnnotatedGaps = 0;
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
$elementDistance++;
my ( $nextHitName, $nextClassName ) =
split( /\#/, $nextAnnot->getSeq2Name() );
if ( $DEBUG ) {
print STDERR " -vs-: ";
$nextAnnot->print();
}
my $queryGap = $lastAnnot->getQueryGap( $nextAnnot );
if ( $queryGap >= 100 ) {
$unAnnotatedBP += $queryGap;
# Only count a series of low/simple repeats as one gap
if ( $currentAnnot->getClassName !~ /^simple|low/i ) {
$unAnnotatedGaps++;
}
}
$lastAnnot = $nextAnnot;
# We don't care to record the divergence of simple/low complexity
if ( $lastDivAnnot
&& $lastDivAnnot->getClassName() !~ /^simple|low/i )
{
$highestInterveningDiv = $lastDivAnnot->getPctSubst()
if ( $highestInterveningDiv < $lastDivAnnot->getPctSubst() );
}
$lastDivAnnot = $nextAnnot;
# Number of intervening elements of the same class
$classElementDistance++ if ( $nextClassName eq $currentClassName );
#
# Reasons we wouldn't consider this element in our cluster and
# trigger the end to the search
#
# A parent join ends at this element
# A much older element is reached ( higher cutlevel )
# A much older intervening ( any class ) element.
# A set of unannotated gaps exceeds our threshold
# When the 21st annotation is reached
#
if (
$nextAnnot->containsElement( $currentAnnot )
|| $currentAnnot->getSeq1Name() ne $nextAnnot->getSeq1Name()
|| $elementDistance > 21
|| ( $unAnnotatedBP * $unAnnotatedGaps ) > 10000
|| (
# Think about these impacts a bit:
# Don't give up on high intervening
# divergence if ( LTR-int or a SINE )
!&isInternal( $nextAnnot ) && $currentClassName !~ /SINE/
&& (
( $currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() )
> 50
&& &isTooDiverged(
$currentAnnot->getPctSubst(),
$highestInterveningDiv
)
)
)
)
{
last;
}
#
if ( $ignoreUntil ) {
if ( $ignoreUntil == $nextAnnot ) {
$ignoreUntil = undef;
}
print STDERR "ignoring...\n" if ( $DEBUG );
next;
}
if ( defined $refinementHash{ $nextAnnot->getCATID() }
&& keys %{ $refinementHash{ $nextAnnot->getCATID() } }
&& !$nextAnnot->getLeftLinkedHit() )
{
#print STDERR "Pushing...\n";
push @candidateJoins, $nextAnnot;
}
if ( $nextAnnot->getRightLinkedHit() ) {
print STDERR "This has a right linked hit\n" if ( $DEBUG );
$ignoreUntil = $nextAnnot->getRightLinkedHit();
}
} # While ( proxIter->hasNext() ) .... searching for candidates
# Do we have some candidate joins for this entry?
if ( @candidateJoins ) {
if ( $DEBUG ) {
print STDERR "Candidates found:\n";
foreach my $tmp ( @candidateJoins ) {
print STDERR " + ";
$tmp->print();
print "\n";
}
}
# Lookup seed refinement twin
# ie. Given RM Hit $currentAnnot:
# -----AluJb------>
#
# And refinement alignments:
# -----AluJo--->
# -----FRAM_A--->
# ----AluJb------> ====> Locate this "twin" alignment and call it $currentMatch
# ----7SLRNA->
#
# TODO: Only doing this to get currentLenThresh?
#
my $currentMatch = getMatchingRefinedEntry( $currentAnnot );
# NOTE: This is to get around strange batch overlap behaviour where the twin doesn't exist
# in the refinement set. Found in hg18:chr9:131500000-132000000
$currentMatch = $currentAnnot if ( !defined $currentMatch );
if ( $DEBUG ) {
print STDERR "Current match = \n ";
$currentMatch->print();
}
my $currentLenThresh = (
$currentMatch->getSeq1End() - $currentMatch->getSeq1Beg() + 1 ) *
.70;
# Filter out hits that are less than 80% of the score of
# the highest scoring realignment or 200 less than the
# the score of the highest scoring realignment whichever
# threshold is more permissive.
my $chs = getRefinedHighScore( $currentAnnot );
my $currentScoreThresh = $chs * 0.80;
$currentScoreThresh = $chs - 100
if ( $chs - $currentScoreThresh < 100 );
my $prevLinkedAnnot = $currentAnnot->getRightLinkedHit();
my $continuationScoreHash = undef;
if ( $prevLinkedAnnot
&& defined $prevScoreHash{ $currentAnnot->getCATID() } )
{
$continuationScoreHash =
$prevScoreHash{ $currentAnnot->getCATID() };
}
#
# Iterate through currentAnnot's refinement alignments and score each
# one against each candidate's refinement alignments keeping the highest
# score as we go.
#
my $forwardHighScore = 0;
my $forwardHighScoringCandidateEquiv = undef;
my $forwardHighScoringCurrentEquiv = undef;
my $forwardHighScoringCandidate = undef;
my %currentScores = ();
foreach my $currentEquiv ( getEquivArray( $currentAnnot ) ) {
if ( $DEBUG ) {
print STDERR " - Current Seed Equiv: ";
$currentEquiv->print;
}
# Don't bother with tiny sub-alignments produced by realignment
next
if (
$currentEquiv->getSeq1End() - $currentEquiv->getSeq1Beg() + 1 <
$currentLenThresh );
print STDERR " - not tiny\n" if ( $DEBUG );
next if ( $currentEquiv->getSW() < $currentScoreThresh );
print STDERR " - high enough score\n" if ( $DEBUG );
# Don't bother if consensus remaining is lower
next
if (
(
$currentEquiv->getRevComp() ne "C"
&& $currentEquiv->get3PrimeUnaligned() < 20
)
|| ( $currentEquiv->getRevComp() eq "C"
&& $currentEquiv->getSeq1Beg() < 20 )
);
print STDERR " - enough consensus remaining\n"
if ( $DEBUG );
# TODO: If currentAnnot is joined previously then use the list of possible names
# to constrain this search.
next
if ( $continuationScoreHash
&& !
defined $continuationScoreHash->{ $currentEquiv->getHitName() }
);
print STDERR " - previous joins make this name possible\n"
if ( $DEBUG );
my $sourceScore = 0;
my $score = 0;
my @finalJoins = ();
my @finalEquivs = ();
my $compatibleDistance = 1;
my @prevCandidates = ();
foreach my $candidate ( @candidateJoins ) {
my $candidateMatch = getMatchingRefinedEntry( $candidate );
next if ( !defined $candidateMatch );
my $candidateLenThresh = (
$candidateMatch->getSeq1End() - $candidateMatch->getSeq1Beg()
+ 1 ) * .70;
# Filter out hits that are less than 80% of the score of
# the highest scoring realignment or 200 less than the
# the score of the highest scoring realignment whichever
# threshold is more permissive.
my $chs = getRefinedHighScore( $candidate );
#print STDERR "Chs = $chs\n";
my $candidateScoreThresh = $chs * 0.80;
$candidateScoreThresh = $chs - 100
if ( $chs - $candidateScoreThresh < 100 );
my $candidateEquivHighScore = 0;
my $cEquiv = undef;
foreach my $candidateEquiv (
getMatchingRefinedEntries( $candidate, $currentEquiv ) )
{
next
if ( $candidateEquiv->getSeq1End() -
$candidateEquiv->getSeq1Beg() + 1 < $candidateLenThresh );
#print STDERR "Threshold = $candidateScoreThresh\n";
next if ( $candidateEquiv->getSW() < $candidateScoreThresh );
my $tmpScore =
scoreRefinedSINEPair( $currentEquiv, $candidateEquiv,
$compatibleDistance );
if ( $tmpScore > $candidateEquivHighScore ) {
$candidateEquivHighScore = $tmpScore;
$cEquiv = $candidateEquiv;
}
} # foreach candidateEquiv
if ( $continuationScoreHash
&& $candidateEquivHighScore
&& defined
$continuationScoreHash->{ $currentEquiv->getHitName() } )
{
print STDERR
"Adjusting candidate score due to prevScoreHash entry\n"
if ( $DEBUG );
$candidateEquivHighScore +=
$continuationScoreHash->{ $currentEquiv->getHitName() };
}
if ( $candidateEquivHighScore ) {
## Check backwards in ( @candidates ) to make sure that the
## isn't an intervening higher scoring join.
my $backwardHighScore = 0;
my $cEquivLengthThresh =
( $cEquiv->getSeq1End() - $cEquiv->getSeq1Beg() + 1 ) *
.70;
my $cDistance = 1;
foreach my $highScoreCandidateEquiv (
getEquivArray( $candidate ) )
{
# Don't bother with tiny sub-alignments produced by realignment
next
if ( $highScoreCandidateEquiv->getSeq1End() -
$highScoreCandidateEquiv->getSeq1Beg() + 1 <
$cEquivLengthThresh );
my $prevCandidateEquivHighScore = 0;
foreach my $prevCandidate ( @prevCandidates ) {
my $prevCandidateMatch =
getMatchingRefinedEntry( $prevCandidate );
next if ( !defined $prevCandidateMatch );
my $prevCandidateLenThresh =
( $prevCandidateMatch->getSeq1End() -
$prevCandidateMatch->getSeq1Beg() + 1 ) * .70;
foreach my $prevCandidateEquiv (
getMatchingRefinedEntries( $prevCandidate ) )
{
next
if ( $prevCandidateEquiv->getSeq1End() -
$prevCandidateEquiv->getSeq1Beg() + 1 <
$prevCandidateLenThresh );
my $tmpScore =
scoreRefinedSINEPair( $prevCandidateEquiv,
$highScoreCandidateEquiv, $cDistance );
#print STDERR "tmpScore = $tmpScore, ";
if ( $tmpScore > $prevCandidateEquivHighScore ) {
$prevCandidateEquivHighScore = $tmpScore;
}
}
}
if ( $prevCandidateEquivHighScore > $backwardHighScore ) {
$cDistance++;
$backwardHighScore = $prevCandidateEquivHighScore;
}
}
if ( $backwardHighScore < $candidateEquivHighScore ) {
print STDERR
"We have a new forward high score of $candidateEquivHighScore\n"
if ( $DEBUG );
$compatibleDistance++;
$currentScores{ $currentEquiv->getHitName() } =
$candidateEquivHighScore;
if ( $candidateEquivHighScore > $forwardHighScore ) {
$forwardHighScore = $candidateEquivHighScore;
$forwardHighScoringCandidateEquiv = $cEquiv;
$forwardHighScoringCurrentEquiv = $currentEquiv;
$forwardHighScoringCandidate = $candidate;
}
}
else {
print STDERR
"Backward high score of $backwardHighScore invalidates"
. " the current forward high score of $candidateEquivHighScore\n"
if ( $DEBUG );
}
}
push @prevCandidates, $candidate;
} # for each candidate
} # foreach currentEquiv
if ( $DEBUG ) {
print STDERR "forwardHighScore = $forwardHighScore\n";
if ( keys( %currentScores ) > 1 ) {
print STDERR "Other high scores:\n";
foreach my $key ( keys( %currentScores ) ) {
print STDERR " $key = " . $currentScores{$key} . "\n";
}
}
}
# Join code
if ( $forwardHighScore ) {
if ( $DEBUG ) {
print STDERR "Joining: \n ";
$forwardHighScoringCurrentEquiv->print();
print STDERR " with \n ";
$forwardHighScoringCandidateEquiv->print();
}
if ( defined $continuationScoreHash ) {
print STDERR "Updating prevScoreHash!\n" if ( $DEBUG );
foreach my $key ( keys( %{$continuationScoreHash} ) ) {
if ( defined $currentScores{$key} ) {
$prevScoreHash{ $forwardHighScoringCandidate->getCATID() }
->{$key} =
$prevScoreHash{ $currentAnnot->getCATID() }->{$key} +
$currentScores{$key};
}
}
}
else {
print STDERR "Creating new prevScoreHash\n" if ( $DEBUG );
$prevScoreHash{ $forwardHighScoringCandidate->getCATID() } =
{%currentScores};
#print "Dumper prevScoreHash: " . Dumper( \%prevScoreHash ) . "\n";
}
# TODO: Trim prevScoreHash so it doesn't just keep growing!
my $leftAnnot = $currentAnnot;
my $leftEquiv = $forwardHighScoringCurrentEquiv;
if ( $leftAnnot->getHitName() ne $leftEquiv->getHitName() ) {
## Special case: If leftAnnot was fragmented by RM then we
## need to treat the equivalent differently.
##
if ( $leftAnnot->getLeftLinkedHit()
&& $leftAnnot->getCATID() eq
$leftAnnot->getLeftLinkedHit()->getCATID() )
{
&replaceRMFragmentChainWithRefinement( $leftAnnot,
$leftEquiv );
}
else {
$leftAnnot->setHitName( $leftEquiv->getHitName() );
$leftAnnot->setSW( $leftEquiv->getSW() );
$leftAnnot->setPctSubst( $leftEquiv->getPctSubst() );
$leftAnnot->setPctDelete( $leftEquiv->getPctDelete() );
$leftAnnot->setPctInsert( $leftEquiv->getPctInsert() );
$leftAnnot->setSeq1Name( $leftEquiv->getSeq1Name() );
$leftAnnot->setSeq1Beg( $leftEquiv->getSeq1Beg() );
$leftAnnot->setSeq1End( $leftEquiv->getSeq1End() );
$leftAnnot->setLeftOver( $leftEquiv->getLeftOver() );
$leftAnnot->setRevComp( $leftEquiv->getRevComp() );
$leftAnnot->setHitName( $leftEquiv->getHitName() );
$leftAnnot->setClassName( $leftEquiv->getClassName() );
$leftAnnot->setSeq2Beg( $leftEquiv->getSeq2Beg() );
$leftAnnot->setSeq2End( $leftEquiv->getSeq2End() );
$leftAnnot->set3PrimeUnaligned(
$leftEquiv->get3PrimeUnaligned() );
}
$leftAnnot->setDerivedFromAnnot( $leftEquiv );
}
my $rightAnnot = $forwardHighScoringCandidate;
$leftAnnot->setRightLinkedHit( $rightAnnot );
$rightAnnot->setLeftLinkedHit( $leftAnnot );
my $rightEquiv = $forwardHighScoringCandidateEquiv;
if ( $rightAnnot->getHitName() ne $rightEquiv->getHitName()
|| ( $rightAnnot->getSW() < $rightEquiv->getSW() ) )
{
# Special case: Given that b1s4i3 joins to the previously joined
# RM fragmented repeat b1s6i8
#
# +-----------+
# ---b1s4i3---> | |
# ---b1s6i8---> -----b1s6i8--->
#
# and given the relalignment:
#
# --------[b1s6i8]---------->
#
# we must fragment [b1s6i8] into something approximating the
# original fragments and then replace the original ones.
#
if ( $rightAnnot->getRightLinkedHit()
&& $rightAnnot->getCATID() eq
$rightAnnot->getRightLinkedHit()->getCATID() )
{
&replaceRMFragmentChainWithRefinement( $rightAnnot,
$rightEquiv );
}
else {
$rightAnnot->setHitName( $rightEquiv->getHitName() );
$rightAnnot->setSW( $rightEquiv->getSW() );
$rightAnnot->setPctSubst( $rightEquiv->getPctSubst() );
$rightAnnot->setPctDelete( $rightEquiv->getPctDelete() );
$rightAnnot->setPctInsert( $rightEquiv->getPctInsert() );
$rightAnnot->setSeq1Name( $rightEquiv->getSeq1Name() );
$rightAnnot->setSeq1Beg( $rightEquiv->getSeq1Beg() );
$rightAnnot->setSeq1End( $rightEquiv->getSeq1End() );
$rightAnnot->setLeftOver( $rightEquiv->getLeftOver() );
$rightAnnot->setRevComp( $rightEquiv->getRevComp() );
$rightAnnot->setHitName( $rightEquiv->getHitName() );
$rightAnnot->setClassName( $rightEquiv->getClassName() );
$rightAnnot->setSeq2Beg( $rightEquiv->getSeq2Beg() );
$rightAnnot->setSeq2End( $rightEquiv->getSeq2End() );
$rightAnnot->set3PrimeUnaligned(
$rightEquiv->get3PrimeUnaligned() );
}
$rightAnnot->setDerivedFromAnnot( $rightEquiv );
}
$leftAnnot = $rightAnnot;
}
} # if ( @candidateJoins )
} # if seed
} # cycle5a
} # if refcat.....
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 6 ################################
#
# LINE/LTR/SINE Joining Algorithm
#
########################################################################
print STDERR "\ncycle 6 ";
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$i = -1;
$DEBUG = 0;
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
my $currentHitName = $currentAnnot->getHitName();
my $currentClassName = $currentAnnot->getClassName();
#
# This is not a simple/low complexity joinging loop.
# Skip these and do not include them in the intervening
# divergence calculations. Also skip DNA Transposons
# which were joined in a previous cycle.
#
next if ( $currentClassName =~ /^simple|low|dna/i );
my $maxScore = 0;
my $maxScoringAnnot = undef;
#
# Do not attempt to link fragments which are already
# pre-linked.
#
if ( !$currentAnnot->getRightLinkedHit() ) {
if ( $DEBUG ) {
print STDERR "\nCYCLE6: Considering:\n";
$currentAnnot->print();
}
# Look into our future
my $proxIter = $cycleAnnotIter->getIterator();
my $ignoreUntil;
my $classElementDistance = 0;
my $totElementDistance = 0;
my $highestInterveningDiv = 0;
my $unAnnotatedBP = 0;
my $unAnnotatedGaps = 0;
my $lastDivAnnot = undef;
my $lastAnnot = $currentAnnot;
my $score = 0;
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
my $nextHitName = $nextAnnot->getHitName();
my $nextClassName = $nextAnnot->getClassName();
$totElementDistance++;
#
# A new statistic for giving up on joins
# - Count all un-annoted gaps > threshold ( currently 100 )
# - Sum all bp in the above gaps
#
my $queryGap = $lastAnnot->getQueryGap( $nextAnnot );
if ( $queryGap >= 100 ) {
$unAnnotatedBP += $queryGap;
# Only count a series of low/simple repeats as one gap
if ( $currentAnnot->getClassName !~ /^simple|low/i ) {
$unAnnotatedGaps++;
}
}
$lastAnnot = $nextAnnot;
# We don't care to record the divergence of simple/low complexity
if ( $lastDivAnnot
&& $lastDivAnnot->getClassName() !~ /^simple|low/i )
{
$highestInterveningDiv = $lastDivAnnot->getPctSubst()
if ( $highestInterveningDiv < $lastDivAnnot->getPctSubst() );
}
$lastDivAnnot = $nextAnnot;
# Number of intervening elements of the same class
$classElementDistance++ if ( $nextClassName eq $currentClassName );
if ( $DEBUG ) {
print STDERR " $totElementDistance -vs-> ";
$nextAnnot->print();
print STDERR
" unAnnotatedBP = $unAnnotatedBP * unAnnoatedGaps = $unAnnotatedGaps < 10000\n";
}
#
# Reasons we wouldn't consider this element in our cluster and
# trigger the end to the search
#
# A parent join ends at this element
# A much older element is reached ( higher cutlevel )
# A much older intervening ( any class ) element.
# A set of unannotated gaps exceeds our threshold
# When the 21st annotation is reached
#
if (
$nextAnnot->containsElement( $currentAnnot )
|| $currentAnnot->getSeq1Name() ne $nextAnnot->getSeq1Name()
|| $totElementDistance > 21
|| ( $unAnnotatedBP * $unAnnotatedGaps ) > 10000
|| (
# Think about these impacts a bit:
# Don't give up on high intervening
# divergence if ( LTR-int or a SINE )
!&isInternal( $nextAnnot ) && $currentClassName !~ /SINE/
&& (
( $currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() ) >
50
&& &isTooDiverged(
$currentAnnot->getPctSubst(),
$highestInterveningDiv
)
)
)
)
{
if ( $DEBUG ) {
print STDERR " ---> This element is beyond our "
. "consideration boundary:\n";
print STDERR " totElementDistance = "
. "$totElementDistance\n";
print STDERR " highestInterveningDiv = "
. "$highestInterveningDiv\n";
print STDERR " unAnnotatedBP = $unAnnotatedBP\n";
print STDERR " unAnnotatedGaps = $unAnnotatedGaps\n";
print STDERR " isTooDiverged() = "
. &isTooDiverged( $currentAnnot->getPctSubst(),
$highestInterveningDiv )
. "\n";
print STDERR " containsElement ==> "
. $nextAnnot->containsElement( $currentAnnot ) . "\n";
}
last;
}
#
# Move along if we are moving over a joined set of
# fragments ( and their children ) which cannot be joined
# to us. This flag is set below.
#
# +--------joined------------+
# | |
# --current-- -----+---- --- ------ ---+--- -----
# *skip* *skip* *skip*
#
if ( $ignoreUntil
&& $ignoreUntil != $nextAnnot )
{
print STDERR " --> Ignoring joined fragments\n" if ( $DEBUG );
next;
}
else {
$ignoreUntil = undef;
}
#
# Do not consider this one if it has a much lower divergence than
# something in between. This is the symmetric opposite of the
# catch above.
#
# TODO: Consider doing this for SINES as above
#
if ( !&isInternal( $nextAnnot )
&& $nextAnnot->getSeq2End() - $nextAnnot->getSeq2Beg() > 50
&& &isTooDiverged( $nextAnnot->getPctSubst(),
$highestInterveningDiv ) )
{
if ( $DEBUG ) {
print STDERR " --> This has a much lower div than something "
. "in between: interveningHitDiv = $highestInterveningDiv\n";
}
next;
}
##### TODO Uncomment this and remove the duplicate code at bottom
#
# Need to ignore all element until we reach the right-hand element.
#
if ( $nextAnnot->getRightLinkedHit() ) {
if ( $DEBUG ) {
print STDERR " ---> Has right linked hit...ignoring until: ";
$nextAnnot->getRightLinkedHit()->print();
}
$ignoreUntil = $nextAnnot->getRightLinkedHit();
}
#
# Don't join fragments of different classes.
#
if ( $nextClassName ne $currentClassName ) {
print STDERR " --> Not same class...moving on\n" if ( $DEBUG );
next;
}
#
# Only elements not already linked to something before the
# current element:
#
# +--------joined------------+
# | |
# --current-- -----+---- --- ------ ---+--- -----
# *skip*
#
if ( !$nextAnnot->getLeftLinkedHit() ) {
# LINE Equivalences ( SINE/LTR are not handled this way )
my @currentNames = ( $currentAnnot->getSeq2Name() );
if ( defined $currentAnnot->getEquivHash() ) {
push @currentNames, keys( %{ $currentAnnot->getEquivHash() } );
}
#print STDERR "Dumper: " . Dumper(\@currentNames) . "\n";
my @nextNames = ( $nextAnnot->getSeq2Name() );
if ( defined $nextAnnot->getEquivHash() ) {
push @nextNames, keys( %{ $nextAnnot->getEquivHash() } );
}
my $savedCName = $currentAnnot->getSeq2Name();
my $savedNName = $nextAnnot->getSeq2Name();
foreach my $cName ( @currentNames ) {
print STDERR " -->trying current name: $cName\n"
if ( $DEBUG );
$currentAnnot->setSeq2Name( $cName );
foreach my $nName ( @nextNames ) {
print STDERR " -->trying next name: $nName\n"
if ( $DEBUG );
$nextAnnot->setSeq2Name( $nName );
if ( $currentClassName =~ /LINE/ ) {
$score = &scoreLINEPair( $currentAnnot, $nextAnnot,
$classElementDistance, \%options );
}
elsif ( $currentClassName =~ /LTR/ ) {
$score =
&scoreLTRPair( $currentAnnot, $nextAnnot,
$totElementDistance,
$classElementDistance );
}
elsif ( $currentClassName =~ /SINE/
&& $currentClassName !~ /Alu/ )
{
$score =
&scoreSINEPair( $currentAnnot, $nextAnnot,
$totElementDistance,
$classElementDistance );
}
else {
$score =
&scoreGenericPair( $currentAnnot, $nextAnnot,
$totElementDistance, $classElementDistance );
}
if ( $score > 0 ) {
print STDERR " --> Ambiguous names matched:"
. " $cName, $nName\n"
if ( $DEBUG );
last;
}
}
last if ( $score > 0 );
} # foreach my $cName...
$currentAnnot->setSeq2Name( $savedCName );
$nextAnnot->setSeq2Name( $savedNName );
print STDERR " ---Wow saved one!\n"
if ( $score > 0 && $DEBUG );
#
# If we found a compatible match we now look backwards
# to see if there was a better intervening match to
# the candidate. I.e preserve the "best-closest-match"
# concept.
#
# +------------good-----------------+
# | +-better-+ |
# | | | |
# ----current--- ----- ---+--- ---+----+---
#
# Ignore this match if there is a better intervening
# match.
#
if ( $score > 0 ) {
print STDERR " \\----> score = $score\n" if ( $DEBUG );
my $revIter = $proxIter->getIterator();
$revIter->previous();
my $inBetweenDistance = 0;
my $classBetweenDistance = 0;
my $inBetweenScore = 0;
my $prevAnnot;
print STDERR " Looking backwards to see if there was a "
. "better match\n"
if ( $DEBUG );
while ( $revIter->hasPrevious() ) {
$prevAnnot = $revIter->previous();
if ( $DEBUG ) {
print STDERR " -vs-> ";
$prevAnnot->printBrief();
}
$inBetweenDistance++;
$classBetweenDistance++;
# Look backwards up to $currentAnnot
last if ( $prevAnnot == $currentAnnot );
next
if (
$prevAnnot->getClassName() ne $currentAnnot->getClassName() );
if ( $currentClassName =~ /LINE/ ) {
$inBetweenScore = &scoreLINEPair(
$prevAnnot, $nextAnnot,
$inBetweenDistance, \%options
);
}
elsif ( $currentClassName =~ /LTR/ ) {
$inBetweenScore =
&scoreLTRPair( $prevAnnot, $nextAnnot, $inBetweenDistance,
$classBetweenDistance );
}
elsif ( $currentClassName =~ /SINE/ ) {
$inBetweenScore =
&scoreSINEPair( $prevAnnot, $nextAnnot,
$inBetweenDistance );
}
else {
$inBetweenScore =
&scoreGenericPair( $prevAnnot, $nextAnnot,
$inBetweenDistance, $classElementDistance );
}
last if ( $inBetweenScore >= $score );
}
if ( $inBetweenScore >= $score ) {
# Abandon match, there is an intervening better match
print STDERR " \\--> Better intervening score "
. "$inBetweenScore\n"
if ( $DEBUG );
}
else {
print STDERR " ---> Sticking with first match: score=$score\n"
if ( $DEBUG );
if ( $maxScore < $score ) {
$maxScore = $score;
$maxScoringAnnot = $nextAnnot;
}
}
}
}
else {
if ( $DEBUG ) {
print STDERR " ---> Already linked to something on left"
. "\n ";
$nextAnnot->getLeftLinkedHit()->printBrief();
}
}
#### TODO: REMOVE THIS
#
# Need to ignore all element until we reach the right-hand element.
#
#if ( $nextAnnot->getRightLinkedHit() ) {
# print STDERR " ---> Has right linked hit...ignoring until\n"
# if ( $DEBUG );
# $ignoreUntil = $nextAnnot->getRightLinkedHit();
#}
} # while ( $proxIter->hasNext()...
if ( $maxScore > 0 ) {
if ( $DEBUG ) {
print STDERR " *** And the winner is: score = $maxScore\n ";
$maxScoringAnnot->print();
}
$currentAnnot->setRightLinkedHit( $maxScoringAnnot );
$maxScoringAnnot->setLeftLinkedHit( $currentAnnot );
}
}
}
$DEBUG = 0;
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 7 ################################
#
# Name joined LINE/LTR clusters
#
########################################################################
print STDERR "\ncycle 7 ";
##
## Name joined fragments & pick consensus adjustment
##
## The name of a chain is determined by the highest scoring
## fragment in the highest priority model group. The model
## groups are ( in order of priority ) 3-Prime End Models,
## 5-Prime End Models, ORF Models, and Undesignated Models.
##
## Also the consensus adjustment is calculated by finding
## the highest consensus adjustment from conPosCorrection
## for the given fragment chain.
##
$DEBUG = 0;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$i = -1;
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "Considering: ";
$currentAnnot->print();
}
# RMH: IN DEVELOPMENT
# TODO: Handle pre-joined non-chain fragments
# TODO: Get rid of refcat an make dependent on refined datastructure
if ( $options{'refcat'}
&& defined $refinementHash{ $currentAnnot->getCATID() }
&& $currentAnnot->getSeq2Name =~ /Alu/
&& !$currentAnnot->getLeftLinkedHit()
&& !$currentAnnot->getRightLinkedHit() )
{
my $currentAnnotRefinedMatch = getMatchingRefinedEntry( $currentAnnot );
# See above problem with batch overlaps
$currentAnnotRefinedMatch = $currentAnnot
if ( !defined $currentAnnotRefinedMatch );
my $lengthThreshold =
( $currentAnnotRefinedMatch->getSeq1End() -
$currentAnnotRefinedMatch->getSeq1Beg() ) + 1 - 10;
if ( $DEBUG ) {
print STDERR "Match: ";
$currentAnnotRefinedMatch->print();
}
my $maxScore = 0;
my $maxScoringElement = undef;
foreach my $ele ( getEquivArray( $currentAnnot ) ) {
if ( $ele->getSW() > $maxScore ) {
$maxScore = $ele->getSW();
$maxScoringElement = $ele;
}
}
print STDERR "lengthThreshold = $lengthThreshold\n" if ( $DEBUG );
if (
$maxScoringElement
&& (
$maxScoringElement->getSeq1End() - $maxScoringElement->getSeq1Beg +
1 > $lengthThreshold )
)
{
$currentAnnot->setHitName( $maxScoringElement->getHitName() );
$currentAnnot->setSW( $maxScoringElement->getSW() );
$currentAnnot->setPctSubst( $maxScoringElement->getPctSubst() );
$currentAnnot->setPctDelete( $maxScoringElement->getPctDelete() );
$currentAnnot->setPctInsert( $maxScoringElement->getPctInsert() );
$currentAnnot->setSeq1Name( $maxScoringElement->getSeq1Name() );
$currentAnnot->setSeq1Beg( $maxScoringElement->getSeq1Beg() );
$currentAnnot->setSeq1End( $maxScoringElement->getSeq1End() );
$currentAnnot->setLeftOver( $maxScoringElement->getLeftOver() );
$currentAnnot->setRevComp( $maxScoringElement->getRevComp() );
$currentAnnot->setHitName( $maxScoringElement->getHitName() );
$currentAnnot->setClassName( $maxScoringElement->getClassName() );
$currentAnnot->setSeq2Beg( $maxScoringElement->getSeq2Beg() );
$currentAnnot->setSeq2End( $maxScoringElement->getSeq2End() );
$currentAnnot->set3PrimeUnaligned(
$maxScoringElement->get3PrimeUnaligned() );
$currentAnnot->setDerivedFromAnnot( $maxScoringElement );
if ( $DEBUG ) {
print STDERR "I did this with it: ";
$currentAnnot->print();
}
}
}
# We only care about LINES/LTR for the rest
next if ( $currentAnnot->getSeq2Name !~ /LINE|LTR/ );
# Consider only left ( from our direction of iteration )
# fragment ends
if ( $currentAnnot->getRightLinkedHit()
&& !$currentAnnot->getLeftLinkedHit()
|| !$currentAnnot->getLeftLinkedHit()
&& !$currentAnnot->getRightLinkedHit() )
{
my @elements = ();
push @elements, $currentAnnot;
# Follow links until end
my $nextInChain = $currentAnnot;
my $highestConCorr = $conPosCorrection{ $nextInChain->getID() };
if ( $DEBUG ) {
print STDERR "Naming Current:\n";
$currentAnnot->print();
}
while ( $nextInChain ) {
if ( $DEBUG ) {
print STDERR " -- ";
$nextInChain->print();
print STDERR " \\--- ID="
. $nextInChain->getID()
. " con{ID} = "
. $conPosCorrection{ $nextInChain->getID() }
. " highest = "
. $highestConCorr . "\n";
}
push @elements, $nextInChain;
$highestConCorr = $conPosCorrection{ $nextInChain->getID() }
if (
$conPosCorrection{ $nextInChain->getID() } > $highestConCorr );
$nextInChain = $nextInChain->getRightLinkedHit();
}
$nextInChain = $elements[ $#elements ];
# LTR or LINE
my $newLINEName = "";
my $newLTRName = "";
my $newLTRIntName = "";
if ( $currentAnnot->getClassName =~ /LTR/ ) {
@elements =
sort {
isLTR( $b ) <=> isLTR( $a )
|| $b->getSW() <=> $a->getSW();
} @elements;
my $winner = $elements[ 0 ];
$newLTRName = $winner->getHitName() if ( isLTR( $winner ) );
@elements =
sort {
isInternal( $b ) <=> isInternal( $a )
|| $b->getSW() <=> $a->getSW();
} @elements;
$winner = shift @elements;
$newLTRIntName = $winner->getHitName() if ( isInternal( $winner ) );
$newLTRIntName =~ s/-int//g;
}
else {
@elements =
sort {
my $nameA = $a->getSeq2Name();
my $nameB = $b->getSeq2Name();
( $nameA ) = ( $nameA =~ /(_5end|_3end|_orf2)/ );
( $nameB ) = ( $nameB =~ /(_5end|_3end|_orf2)/ );
$nameA = "_zzz" if ( $nameA eq "" );
$nameB = "_zzz" if ( $nameB eq "" );
$nameA cmp $nameB || $b->getSW() <=> $a->getSW();
} @elements;
my $winner = shift @elements;
$newLINEName = $winner->getSeq2Name();
}
# Now change the names
while ( $nextInChain ) {
if ( $currentAnnot->getClassName() =~ /LTR/ ) {
if ( isInternal( $nextInChain ) ) {
if ( $newLTRName
&& $nextInChain->getClassName() =~ /ERVL-MaLR/ )
{
# Name after LTR
$nextInChain->setHitName( $newLTRName . "-int" );
}
elsif ( $newLTRIntName ) {
# Name after highest scoring internal
$nextInChain->setHitName( $newLTRIntName . "-int" );
}
}
else {
$nextInChain->setHitName( $newLTRName );
}
}
else {
$nextInChain->setSeq2Name( $newLINEName );
}
if ( $DEBUG ) {
print STDERR "Fixing conPosCorrection(*$highestConCorr): ";
$nextInChain->print();
}
# NOTE: Design improvement potential. LINEs like Hal1B can
# be renamed as other LINES ( ie. L1M7 ). When this
# happens a different adjustment should be used to
# define it's consensus coordinates.
# Here is a good example:
#287 28.17 8.72 4.70 big 5079 5227 (39675) C HAL1b#LINE/L1 (457) 1552 1398 5
#281 25.51 16.59 4.39 big 5136 5298 (39748) C L1M7_5end#LINE/L1 (417) 1820 1637 5
#705 15.03 0.00 8.28 big 5299 5443 (41394) C FLAM_C_short_#SINE/Alu (0) 133 1 3
#281 25.51 16.59 4.39 big 5444 5484 (39562) C L1M7_5end#LINE/L1 (601) 1636 1591 5
#345 27.33 5.26 1.32 big 5506 5657 (39389) C L1M7_5end#LINE/L1 (873) 1364 1207 5
# Consider a design change to handle this.
#
$conPosCorrection{ $nextInChain->getID() } = $highestConCorr;
# Can be linked to itself.
if ( $nextInChain == $nextInChain->getLeftLinkedHit() ) {
last;
}
$nextInChain = $nextInChain->getLeftLinkedHit();
} # while ( $nextInChain...
}
}
$DEBUG = 0;
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 8 ################################
#
# Merge overlapping fragments
#
########################################################################
print STDERR "\ncycle 8 ";
##
## Merge joined overlapping fragments into one fragment
##
## This is basically the old FuseOverlappingSeqs routine.
## The process is basically a cosmetic one -- simplifying
## the output.
##
## Sort by class?
##
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
my $prevAnnot;
$DEBUG = 0;
$i = -1;
while ( $cycleAnnotIter->hasNext() ) {
# Pick one element
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "Considering:\n";
$currentAnnot->print();
}
my $proxIter = $cycleAnnotIter->getIterator();
my $lookAhead = 0;
while ( $proxIter->hasNext() ) {
my $next1Annot = $proxIter->next();
if ( $DEBUG ) {
print STDERR " --vs-->";
$next1Annot->print();
print STDERR " query Gap = "
. $currentAnnot->getQueryGap( $next1Annot ) . "\n";
}
# TODO: Now this is specific for SVA...need to generalize this for
# anything which contains a tandem repeat unit.
last
if (
$next1Annot->getSeq1Name() ne $currentAnnot->getSeq1Name()
|| ( $currentAnnot->getHitName !~ /SVA/
&& $currentAnnot->getQueryGap( $next1Annot ) > 10 )
|| ( $currentAnnot->getHitName() =~ /SVA/
&& $lookAhead++ > 2 )
);
next
if ( $next1Annot->getClassName() ne $currentAnnot->getClassName() );
my $next2Annot = undef;
if ( $proxIter->hasNext() ) {
$next2Annot = $proxIter->next();
$proxIter->previous();
# So as to emit the one we will delete
$proxIter->previous();
$proxIter->next();
}
my $QO = $currentAnnot->getQueryOverlap( $next1Annot );
#
# SVAs
#
# - Special because they contain a vntr region. This region
# behaves in a similar way to satellites or simple repeats.
# As a consequence we have to allow a lessor overlap??
# - also can have different cut levels due to it's placement in
# the Alu(SINES) search phase.....hmmm.
# - Lastly these are not joined yet.
# - Query Gap < 10bp
#
if ( $currentAnnot->getHitName() =~ /SVA/
&& $next1Annot->getHitName() =~ /SVA/ )
{
if ( $currentAnnot->getRevComp() eq "C"
&& $currentAnnot->getSeq2End() > 425
&& $next1Annot->getSeq2End() < 880
|| $currentAnnot->getRevComp() eq "+"
&& $currentAnnot->getSeq2Beg() < 880
&& $next1Annot->getSeq2Beg() > 425 )
{
# rest taken care of elsewhere
if ( $QO >= -10 ) {
if ( $DEBUG ) {
print STDERR "SVA merging:\n";
$currentAnnot->print();
$next1Annot->print();
}
$currentAnnot->merge( $next1Annot );
$currentAnnot->addDerivedFromAnnot( $next1Annot )
if ( $options{'source'} );
$proxIter->remove();
}
else {
if ( $DEBUG ) {
print STDERR "SVA joining\n";
$currentAnnot->print();
$next1Annot->print();
}
$currentAnnot->join( $next1Annot );
last;
}
}
}
elsif ( $currentAnnot->getClassName() =~ /Simple|Satellite/
&& $QO >= -10 )
{
# Simple Repeats and Satellites
my $thislength =
$currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() + 1;
my $lastlength =
$next1Annot->getSeq2End() - $next1Annot->getSeq2Beg() + 1;
if ( $DEBUG ) {
print STDERR " Simple/Satellite";
}
if ( $next1Annot->getSeq1End() >= $currentAnnot->getSeq1End() ) {
if ( $currentAnnot->getHitName() ne $next1Annot->getHitName() ) {
my $nextoverlap = 0;
if ( $next2Annot ) {
if ( $DEBUG ) {
print STDERR " --next->:";
$next2Annot->printBrief();
}
# don't fuse (CA)n(TG)n(CA)n etc
my $tempname = quotemeta $next1Annot->getHitName();
if ( $next2Annot->getSeq2Name() =~ /$tempname/
&& $next1Annot->getSeq1Name() eq $next2Annot->getSeq1Name()
&& $next2Annot->getSeq1Beg() < $next1Annot->getSeq1End() )
{
$nextoverlap = $currentAnnot->getQueryOverlap( $next2Annot );
}
}
#print STDERR " QO=$QO, thislength = $thislength, " .
# "nextoverlap = $nextoverlap\n" if ( $DEBUG );
if (
$QO + $nextoverlap > 10
&&
# just to be sure it's not 0 in the following division
$thislength / ( $QO + $nextoverlap ) < 2
)
{
print STDERR " --> merging!\n" if ( $DEBUG );
$currentAnnot->mergeSimpleLow( $next1Annot );
$currentAnnot->addDerivedFromAnnot( $next1Annot )
if ( $options{'source'} );
$proxIter->remove();
}
}
else {
print STDERR " --> merging!\n" if ( $DEBUG );
$currentAnnot->mergeSimpleLow( $next1Annot );
$currentAnnot->addDerivedFromAnnot( $next1Annot )
if ( $options{'source'} );
$proxIter->remove();
}
}
}
# See if they overlap by some obvious amount
if ( $currentAnnot->getSeq1End() - $next1Annot->getSeq1Beg() + 1 > 33 )
{
print STDERR " -- a big overlap...is it already linked?\n"
if ( $DEBUG );
if ( $currentAnnot->getRightLinkedHit() == $next1Annot ) {
if ( $DEBUG ) {
print STDERR "Merging a joined pair:\n";
$currentAnnot->print();
$next1Annot->print();
}
$currentAnnot->merge( $next1Annot );
$currentAnnot->addDerivedFromAnnot( $next1Annot )
if ( $options{'source'} );
$proxIter->remove();
if ( $DEBUG ) {
print STDERR " Outcome:\n";
$currentAnnot->print();
}
if ( $conPosCorrection{ $currentAnnot->getID() }
&& $currentAnnot->getSeq2Beg() < $next1Annot->getSeq2Beg() )
{
$conPosCorrection{ $next1Annot->getID() } =
$conPosCorrection{ $currentAnnot->getID() };
}
}
elsif ( $DEBUG ) {
print STDERR " No!\n";
#$currentAnnot->printLinks();
}
# If they don't....then try again with a not so obvious
# check
}
elsif (
$currentAnnot->getRightLinkedHit() == $next1Annot
&& $currentAnnot->getRevComp() eq $next1Annot->getRevComp()
&& $currentAnnot->getLastField == $next1Annot->getLastField()
&& $currentAnnot->getQueryGap( $next1Annot ) <= 10
&& $currentAnnot->getConsensusGap( $next1Annot ) <= 100
&& ( $currentAnnot->getConsensusOverlap( $next1Annot ) <= 20
|| $currentAnnot->getQueryGap( $next1Annot ) < 0
&& $currentAnnot->getConsensusOverlap( $next1Annot ) -
$currentAnnot->getQueryOverlap( $next1Annot ) <= 20 )
)
{
# Fuse all remaining neighboring closely related elements that
# overlap or nearly join in the query and have small gaps or tiny
# overlaps in the consensus. This simlplifies the output, though
# there is a further disconnect with the alignments. Since this is
# largely a cosmetic action, selectivity trumps sensitivity.
#
# TODO: Arian suggested that we only join these if the pctDel
# does not exceed some threshold. This limit would keep
# fragments from merging if they contain more info as
# independent annotations.
#
#
my ( $subBases, $subPct, $delBases, $delPct, $insBases, $insPct ) =
$currentAnnot->getAdjustedSubstLevel( $next1Annot );
#
print STDERR "Merged pair would have: subPct = $subPct, "
. "delBases = $delBases, delPct = $delPct, insPct = $insPct\n"
if ( $DEBUG );
#if ( $delPct < 30 )
unless ( $delPct > 50 ) {
if ( $DEBUG ) {
print STDERR "SHOULD MERGE THESE TWO:\n";
$currentAnnot->printBrief();
$next1Annot->printBrief();
}
$currentAnnot->merge( $next1Annot );
$currentAnnot->addDerivedFromAnnot( $next1Annot )
if ( $options{'source'} );
$proxIter->remove();
if ( $DEBUG ) {
print STDERR " Outcome:\n";
$currentAnnot->print();
}
if ( $conPosCorrection{ $currentAnnot->getID() }
&& $currentAnnot->getSeq2Beg() < $next1Annot->getSeq2Beg() )
{
$conPosCorrection{ $next1Annot->getID() } =
$conPosCorrection{ $currentAnnot->getID() };
}
} # if $delPct < 30...
} # Merge close fragments
elsif ( $DEBUG ) {
print STDERR " Don't merge: qo = "
. $currentAnnot->getQueryOverlap( $next1Annot )
. " co = "
. $currentAnnot->getConsensusOverlap( $next1Annot )
. " linked = ";
if ( $currentAnnot->getRightLinkedHit() == $next1Annot ) {
print STDERR "yes";
}
else {
print STDERR "no";
}
print STDERR "\n";
}
} # while proxIter->hasNext()...
}
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 9 ################################
#
# Remove things included in other things???
# LINE Recombinants
# Unhide elements inserted inside other hits
#
########################################################################
print STDERR "\ncycle 9 ";
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
$i = -1;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$DEBUG = 0;
CYCLE9:
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "Cycle9: Considering: ";
$currentAnnot->print();
}
#
# Remove fragments contained by a previous annotation
#
my $pastIter = $cycleAnnotIter->getIterator();
$pastIter->previous();
my $k = 1;
while ( $k++ < 10 && $pastIter->hasPrevious() ) {
my $pastAnnot = $pastIter->previous();
if ( $currentAnnot->getSeq1Name() eq $pastAnnot->getSeq1Name() ) {
my $currentClassName = $currentAnnot->getClassName();
if (
$currentAnnot->getLastField() eq $pastAnnot->getLastField()
&& (
$currentAnnot->getSeq1End() <= $pastAnnot->getSeq1End()
&& ( $currentAnnot->getSeq2Name() eq $pastAnnot->getSeq2Name()
|| $currentAnnot->getSeq2Name() =~ /LTR8$/
&& $pastAnnot->getSeq2Name() =~ /Harlequin/ )
|| (
(
$currentAnnot->getSeq1End() == $pastAnnot->getSeq1End()
|| $currentAnnot->getSeq1Beg() == $pastAnnot->getSeq1Beg()
)
&& $pastAnnot->getClassName() =~ /$currentClassName/
)
)
)
{
if ( $DEBUG ) {
print STDERR "1Removing because it's included in the previous!\n";
$pastAnnot->print();
$currentAnnot->print();
}
if ( $pastAnnot->getRightLinkedHit() == $currentAnnot ) {
print STDERR "Relinking the past\n" if ( $DEBUG );
$pastAnnot->setRightLinkedHit(
$currentAnnot->getRightLinkedHit() );
if ( $currentAnnot->getRightLinkedHit() ) {
$currentAnnot->getRightLinkedHit()
->setLeftLinkedHit( $pastAnnot );
}
}
else { ### What should be done with these? They may have linked
### partners.
}
$currentAnnot->removeFromJoins();
$pastAnnot->addDerivedFromAnnot( $currentAnnot )
if ( $options{'source'} );
$cycleAnnotIter->remove();
next CYCLE9;
}
elsif (
$currentAnnot->getLastField() == 4
&& $pastAnnot->getLastField() == 5
&& $currentAnnot->getSeq2Name() eq $pastAnnot->getSeq2Name()
&& ( $currentAnnot->getSeq1End() == $pastAnnot->getSeq1End()
|| $currentAnnot->getSeq1Beg() == $pastAnnot->getSeq1Beg() )
)
{
if ( $DEBUG ) {
print STDERR "2Removing because it's included in the previous!\n";
$pastAnnot->print();
$currentAnnot->print();
}
if ( $pastAnnot->getRightLinkedHit() == $currentAnnot ) {
print STDERR "Relinking the past\n" if ( $DEBUG );
$pastAnnot->setRightLinkedHit(
$currentAnnot->getRightLinkedHit() );
if ( $currentAnnot->getRightLinkedHit() ) {
$currentAnnot->getRightLinkedHit()
->setLeftLinkedHit( $pastAnnot );
}
} # See above
$currentAnnot->removeFromJoins();
$pastAnnot->addDerivedFromAnnot( $currentAnnot )
if ( $options{'source'} );
$cycleAnnotIter->remove();
next CYCLE9;
}
}
else {
last;
}
}
# March 2004; moved this block to so that recombined elements
# with inserts can be joined properly.
# I have seen insertions in human vs chimp (and chimp vs human) in
# which the gap in the consensus was up to 175 bp
# With new ORF2 consensus seqs less chance of false joining and more
# consistent divergence of fragments, I've reset the allowed gap in the
# consensus from 33 to a calculated distance based on difference in
# divergence level, gap between fragments in query sequence. The gap
# allowed is doubled when the fragments have the same subfamily
# designation.
if ( $currentAnnot->getClassName =~ /^LINE\/L1/ ) {
# special case of (the quite common case of) LINEs integrated
# after recombination this appears as an inversion of part of
# the element giving a <- -> structure. matchL1frags() matches
# up IDs of fragments and improves subfamily name if possible.
# This is not seen in L2,L3 (Perhaps in L4; don't know yet)
my $pastIter = $cycleAnnotIter->getIterator();
$pastIter->previous();
my $forwIter = $cycleAnnotIter->getIterator();
my $n = 1;
my $matched = 0;
while ( $n++ < 6 ) {
my $pastAnnot = undef;
my $pastAnnot = $pastIter->previous() if ( $pastIter->hasPrevious() );
my $nextAnnot = undef;
my $nextAnnot = $forwIter->next() if ( $forwIter->hasNext() );
if ( $pastAnnot
&& $currentAnnot->getSeq1Name() eq $pastAnnot->getSeq1Name()
&& $pastAnnot->getClassName() eq "LINE/L1"
&& $currentAnnot->getSeq1Beg() - $pastAnnot->getSeq1End() <= 20
&& $currentAnnot->getRevComp() eq '+'
&& $pastAnnot->getRevComp() eq "C" )
{
my $gap = $currentAnnot->getSeq1Beg() - $pastAnnot->getSeq1End();
# Overlaps always indicate false extension; neither bad nor good
$gap = 0 if ( $gap < 0 );
# The more different the divergence and the further apart
# the fragments, the stricter the requirements
my $gapallowed = 175 - 20 *
abs( $currentAnnot->getPctSubst() - $pastAnnot->getPctSubst() )
- 5 * $gap;
# Same subfamily name is a big bonus
$gapallowed += 50
if ( $currentAnnot->getHitName() eq $pastAnnot->getHitName() );
if (
$currentAnnot->getSeq2End() - $pastAnnot->getSeq2Beg() <
$gapallowed / 2
&& # overlap should be smaller, but ones seen up to 46 bp
$pastAnnot->getSeq2Beg() - $currentAnnot->getSeq2End() <
$gapallowed
)
{
if ( &areLINENamesCompat( $currentAnnot, $pastAnnot )
|| $currentAnnot->getHitName() =~ /^L1.*_3end$/
&& $currentAnnot->getSeq2End() < 6015
&& $pastAnnot->getSeq2End() - $pastAnnot->getSeq2Beg() > 100 )
{
$matched = $pastAnnot;
last;
}
}
}
elsif ( $nextAnnot
&& $nextAnnot->getSeq2Name() =~ /LINE\/L1/
&& $currentAnnot->getSeq1Name() eq $nextAnnot->getSeq1Name()
&& $nextAnnot->getSeq1Beg() - $currentAnnot->getSeq1End() <= 20
&& $currentAnnot->getRevComp() eq "C"
&& $nextAnnot->getRevComp() eq '+' )
{
my $gap = $nextAnnot->getSeq1Beg() - $currentAnnot->getSeq1End();
$gap = 0 if ( $gap < 0 );
my $gapallowed = 175 - 20 *
abs( $currentAnnot->getPctSubst() - $nextAnnot->getPctSubst() )
- 5 * $gap;
$gapallowed += 50
if ( $nextAnnot->getHitName() eq $currentAnnot->getHitName() );
if ( $currentAnnot->getSeq2End() - $nextAnnot->getSeq2Beg() <
$gapallowed / 2
&& $nextAnnot->getSeq2Beg() - $currentAnnot->getSeq2End <
$gapallowed )
{
if ( &areLINENamesCompat( $currentAnnot, $nextAnnot )
|| $currentAnnot->getHitName() =~ /^L1.*_3end$/
&& $currentAnnot->getSeq2End() < 6015
&& $nextAnnot->getSeq2End() - $nextAnnot->getSeq2Beg() > 100 )
{
$matched = $nextAnnot;
last;
}
}
}
}
if ( $matched ) {
## TODO: This code should be moved before line clusters
## are named and corrections are determined. This
## would reduce having to do this twice.
if ( $DEBUG ) {
print STDERR "Joining recombinant L1's:\n";
$matched->print();
$currentAnnot->print();
}
my $highestConsCorrection = $conPosCorrection{ $matched->getID() };
$highestConsCorrection = $conPosCorrection{ $currentAnnot->getID() }
if ( $conPosCorrection{ $currentAnnot->getID() } >
$highestConsCorrection );
$currentAnnot->join( $matched );
# Fix left
my $chainNext = $currentAnnot;
my $detectLoop = 0;
while ( $chainNext->getLeftLinkedHit() != undef
&& $chainNext->getLeftLinkedHit() != $chainNext
&& $detectLoop < 50 )
{
$chainNext = $chainNext->getLeftLinkedHit();
$conPosCorrection{ $chainNext->getID() } = $highestConsCorrection;
$detectLoop++;
}
# Fix right
$chainNext = $currentAnnot;
$detectLoop = 0;
while ( $chainNext->getRightLinkedHit() != undef
&& $chainNext->getRightLinkedHit() != $chainNext
&& $detectLoop < 50 )
{
$chainNext = $chainNext->getRightLinkedHit();
$conPosCorrection{ $chainNext->getID() } = $highestConsCorrection;
$detectLoop++;
}
# Fix current
$conPosCorrection{ $currentAnnot->getID() } = $highestConsCorrection;
$currentAnnot->setHitName( $matched->getSeq2Name() );
if ( $DEBUG ) {
print STDERR "Result:";
$currentAnnot->print();
}
}
} # if ( $ClassName =~ /^LINE\/L1/...
unless ( $options{'noint'} ) {
my $flankingIter = $cycleAnnotIter->getIterator();
$flankingIter->previous();
my $prevAnnot = undef;
if ( $flankingIter->hasPrevious ) {
$prevAnnot = $flankingIter->previous();
$flankingIter->next();
}
$flankingIter->next();
my $nextAnnot = undef;
if ( $flankingIter->hasNext() ) {
$nextAnnot = $flankingIter->next();
$flankingIter->previous();
}
#
# unhide elements inserted in older elements by breaking up the
# older elements.
#
# ie. ---------LINE--------------------
# ------LTR-----------
#
# These would not get fused in the previous code because
# they are of different classes. Now we need to decide
# if the LINE above should be broken up?
#
my $newSeq2Begin = $currentAnnot->getSeq2Beg();
my $newSeq2End = $currentAnnot->getSeq2End();
my @inserts = ();
# Look for all elements inserted in this entry
# we're estimating the position(s) in Seq2 where the
# insertion(s) took place from the position(s) in Seq1
# Look into the future until
# - The future element isn't contained inside the current one.
# - We have moved into a new query sequence.
my $j = 0;
my $prevNextAnnot = undef;
if ( $DEBUG ) {
print STDERR "Unhide Inserts:\n";
}
while ( $flankingIter->hasNext() ) {
$j++;
$nextAnnot = $flankingIter->next();
if ( $DEBUG ) {
print STDERR " --vs-->";
$nextAnnot->print();
}
last
if ( $nextAnnot->getSeq1End() > $currentAnnot->getSeq1End()
|| $nextAnnot->getSeq1Name() ne $currentAnnot->getSeq1Name() );
# Same class and last field???? Shouldn't these already
# have been caught?
if (
$nextAnnot->getSeq2Name() =~ $currentAnnot->getClassName()
&& $currentAnnot->getLastField() == $nextAnnot->getLastField()
|| # i.e. ignore not yet eliminated overlapping matches to the
# same element
$nextAnnot->getSeq1Beg() < $currentAnnot->getSeq1Beg()
## TODO ASSERT: IF $sortedHits[ $j ]->getSeq1Beg()
## < $BeginAlign
)
{
next;
}
# Too close to the beginning -- just shift it along
elsif ( $j == 1
&& $nextAnnot->getSeq1Beg() <= $currentAnnot->getSeq1Beg() + 5 )
{
# Only 5 bp or less before insertion; move BeginAlign after
# this element
if ( $DEBUG ) {
print STDERR "Only 5bp or less...begin extension...clipping it\n";
}
my $diff = $nextAnnot->getSeq1Beg() - $currentAnnot->getSeq1Beg();
if ( $currentAnnot->getRevComp() eq '+' ) {
$currentAnnot->setSeq2Beg( $currentAnnot->getSeq2Beg() + $diff );
}
else {
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() - $diff );
}
$currentAnnot->setSeq1Beg( $nextAnnot->getSeq1End() + 1 );
if ( $DEBUG ) {
print STDERR "Now:\n";
$currentAnnot->print();
}
# There are cases where exposing an insert by cutting back the
# begin position will change the sort order of a previously joined
# set of fragments. Obvioulsy you don't want a left join
# pointing to something on the right.
$currentAnnot->resortJoins();
next;
}
# Too close to the end -- just shift it along
elsif ( $nextAnnot->getSeq1End() >= $currentAnnot->getSeq1End() - 5 )
{
# Only 5 bp or less after insertion; change EndAlign to
# just before this element
# First remove invalidated inserts
while ( ( $nextAnnot->getSeq1Beg() - 1 ) < $inserts[ $#inserts ] ) {
# Remove insert
pop @inserts;
pop @inserts;
}
if ( $DEBUG ) {
print STDERR "Only 5bp or less...end extension...clipping it\n";
}
my $diff = $currentAnnot->getSeq1End() - $nextAnnot->getSeq1End();
# could do + 1, but penalty for gap == match to X
if ( $currentAnnot->getRevComp() eq 'C' ) {
$currentAnnot->setSeq2Beg( $currentAnnot->getSeq2Beg() + $diff );
}
else {
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() - $diff );
}
$currentAnnot->setSeq1End( $nextAnnot->getSeq1Beg() - 1 );
$currentAnnot->resortJoins();
}
else {
# Do not consider inserts within previous inserts
# ie. ------------------------
# -----------------
# -----------
if ( $prevNextAnnot
&& $nextAnnot->getSeq1End() < $prevNextAnnot->getSeq1End() )
{
next;
}
# Immediate (i.e. within 5 bp) flanking inserts are merged
if ( $prevNextAnnot
&& $nextAnnot->getSeq1Beg() < $prevNextAnnot->getSeq1End() + 5 )
{
# replace last insert end with current one; use last insert start
pop @inserts;
}
else {
push( @inserts, $nextAnnot->getSeq1Beg() );
}
print STDERR "Pushing into inserts\n" if ( $DEBUG );
push( @inserts, $nextAnnot->getSeq1End() );
}
$prevNextAnnot = $nextAnnot;
} # while loop
if ( @inserts ) {
my $lengthQmatch =
$currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() + 1;
for ( my $m = 0 ; $m < $#inserts ; $m += 2 ) {
#print STDERR " inserts[ m, m+1 ] = " . $inserts[$m] . ", " .
# $inserts[ $m + 1 ] . "\n";
my $endInsert = $currentAnnot->getSeq1End();
$endInsert = $inserts[ $m ] if ( $inserts[ $m ] < $endInsert );
$lengthQmatch -= ( $inserts[ $m + 1 ] - $endInsert );
--$inserts[ $m ]; # now last position of
++$inserts[ $m + 1 ];
}
my $bpHitperbpQuery =
( $currentAnnot->getSeq2End() - $currentAnnot->getSeq2Beg() + 1 )
/ $lengthQmatch;
if ( $DEBUG ) {
print STDERR "Total inserts = " . scalar( @inserts ) . "\n"
if ( $DEBUG );
print STDERR "lengthQMatch = $lengthQmatch bpHitperbpQuery = "
. $bpHitperbpQuery . "\n";
}
my @edges = @inserts;
unshift( @edges, $currentAnnot->getSeq1Beg() );
push( @edges, $currentAnnot->getSeq1End() );
my $outline = "";
if ( $DEBUG ) {
print STDERR " Fragmenting:\n";
}
$cycleAnnotIter->remove();
my $newHit = undef;
my $lastNewHit = $currentAnnot->getLeftLinkedHit();
$lastNewHit = undef
if ( $currentAnnot->getLeftLinkedHit() == $currentAnnot );
for ( my $m = 0 ; $m < $#edges ; $m += 2 ) {
my $newBeginAlign = $edges[ $m ];
my $newEndAlign = $edges[ $m + 1 ];
my $fragsize = sprintf( "%d",
( $newEndAlign - $newBeginAlign ) *
$bpHitperbpQuery );
print STDERR " frag size = $fragsize\n" if ( $DEBUG );
if ( $currentAnnot->getRevComp() eq '+' ) {
$newHit = $currentAnnot->clone();
# We don't want to alter the final end position of the
# original match
if ( $m < $#edges - 2 ) {
$newSeq2End = $newSeq2Begin + $fragsize;
my $remainder = $currentAnnot->getSeq2Len() - $newSeq2End;
$newHit->set3PrimeUnaligned( $remainder );
$newHit->setSeq2End( $newSeq2End );
}
$newHit->setSeq1End( $newEndAlign );
$newHit->setSeq1Beg( $newBeginAlign );
$newHit->setSeq2Beg( $newSeq2Begin );
$newSeq2Begin = $newSeq2End + 1;
}
else {
$newHit = $currentAnnot->clone();
if ( $m < $#edges - 2 ) {
my $remainder = $currentAnnot->getSeq2Len() - $newSeq2End;
$newSeq2Begin = $newSeq2End - $fragsize; # estimate
$newHit->setSeq2Beg( $newSeq2Begin );
$newHit->set3PrimeUnaligned( $remainder );
}
$newHit->setSeq1Beg( $newBeginAlign );
$newHit->setSeq1End( $newEndAlign );
$newHit->setSeq2End( $newSeq2End );
$newSeq2End = $newSeq2Begin - 1;
}
if ( $lastNewHit ) {
$newHit->setLeftLinkedHit( $lastNewHit );
$lastNewHit->setRightLinkedHit( $newHit );
}
if ( $DEBUG ) {
print STDERR "Inserting\n";
$newHit->print();
#print STDERR " Linked to left:";
#$newHit->getLeftLinkedHit()->printBrief()
# if ( $newHit->getLeftLinkedHit() );
#print STDERR "\n Linked to right:";
#$newHit->getRightLinkedHit()->printBrief()
# if ( $newHit->getRightLinkedHit() );
#print STDERR "\n";
}
$cycleAnnotIter->insert( $newHit );
$lastNewHit = $newHit;
} # for loop
# Note since we are adding multiple copies of these source
# annotations, we need to make sure this routine makes a deep copy.
#$newHit->addDerivedFromAnnot( $currentAnnot )
# if ( $options{'source'} );
if ( $newHit->getRightLinkedHit() ) {
$newHit->getRightLinkedHit()->setLeftLinkedHit( $newHit );
}
} # if @inserts
}
}
#printHitArrayList( $sortedAnnotationsList );
########################## C Y C L E 10 ################################
# Poly-A Joining Code now lives here
#
########################################################################
print STDERR "\ncycle 10 ";
$sortedAnnotationsList->sort( \&byNameBeginEndrevSWrev );
$i = -1;
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
$DEBUG = 0;
# Local to cycle
my $pastAnnot = undef;
CYCLE10:
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
if ( $DEBUG ) {
print STDERR "Cycle10: Considering: ";
$currentAnnot->print();
}
#
# Join Poly-A tails to SINE or LINE1 annotations:
#
# A Poly A tail defined as:
#
# - A hit to a '(A)n', '(CA)n', '(CAA)n', '(AAA)n' etc
# - a previous hit (within 5) to a Alu,Flam, Fr?am, L1.*_3end,
# L1_.*extended or SVA. Why would you go five back?? Is it
# because you could have overlapping annotations for the previous
# segment of DNA? Why not go back to the limit of the gap that you
# accept?
# - And for each group of element there is a tolerance for
# the amount of consensus that remains unaligned at the end.
# - The annotations are not > 3 bases apart
# - The simple repeat isn't subsumed by more than 30 bases on
# the end. I.e the IR doesn't extend past the simple repeat
# by more than 30 bases.
# - They are in the same orientation, same sequence etc.
# - NOTE: This 30 base limit is due to a search related
# constant. The maximum match to a simple repeat
# is around ~20bp.
#
# TODO: Consider doing the same for repeat tails of other SINEs
# and LINEs. Also could consider limiting this to diverged
# simple repeats. Consider what is the best way to deal
# with the consensus length/masked when the tail exceeds the
# length of the original consensus.
#
# NOTE: This routine makes the assumption that simple repeats
# and low-complexity regions which where fragmented by
# repeatmasker are *not* rejoined above. Rejoining
# is not always appropriate and would cause the code
# below to connect up distant fragments to the ends of
# SINEs and LINEs.
#
my $backIter = $cycleAnnotIter->getIterator();
$backIter->previous();
my $forwIter = $cycleAnnotIter->getIterator();
if (
(
$currentAnnot->getHitName eq '(A)n'
|| $currentAnnot->getHitName =~ /^\(.A{3,6}\)/
|| $currentAnnot->getHitName =~ /^A-rich/
|| $currentAnnot->getHitName eq '(T)n'
|| $currentAnnot->getHitName =~ /^\(T{3,6}.\)/
|| $currentAnnot->getHitName =~ /^T-rich/
)
&& !$options{'noint'}
)
{
my $k = 1;
my $prevAnnot;
my $nextAnnot;
while ( $k < 5 ) {
my ( $prevHitName, $prevClassName );
my ( $nextHitName, $nextClassName );
if ( $backIter->hasPrevious() ) {
$prevAnnot = $backIter->previous();
( $prevHitName, $prevClassName ) =
split( /\#/, $prevAnnot->getSeq2Name() );
}
if ( $forwIter->hasNext() ) {
$nextAnnot = $forwIter->next();
( $nextHitName, $nextClassName ) =
split( /\#/, $nextAnnot->getSeq2Name() );
}
# TODO: Meta data - Should we have a field in the DB called polyAJoiningMinUnaligned?
# If set then join Poly A to element but only if unaligned is < polyAJoiningMinUnaligned
# Basic scenarios
#
# previous current
# --SINE/LINE----..(max 31 or 25 bp )..> (max gap 3bp ) -------A Rich Repeat--->
#
# or
#
# ---SINE/LINE---------.....>
# --(max 31)----------A Rich Repeat----->
if ( $DEBUG ) {
print STDERR "Poly-A Joining Considering:\n";
if ( $prevAnnot ) {
print STDERR " Prev: ";
$prevAnnot->print();
}
print STDERR " Current: ";
$currentAnnot->print();
if ( $nextAnnot ) {
print STDERR " Next: ";
$nextAnnot->print();
}
}
if (
$prevAnnot
# prevAnnot is an Alu or L1 at it's 3' end
&& ( $prevHitName =~ /^Alu|^FLAM/
&& $prevAnnot->get3PrimeUnaligned() <= 32
|| $prevHitName =~ /^FR?AM$|^L1.*|^SVA$/
&& $prevAnnot->get3PrimeUnaligned() < 26 )
# The Alu/L1 and simple repeat are no more than 4bp apart
&& $currentAnnot->getSeq1Beg() - $prevAnnot->getSeq1End() < 4
# Same input sequence
&& $currentAnnot->getSeq1Name eq $prevAnnot->getSeq1Name()
# Alu/L1 is in the forward strand and simple repeat is a Poly-A repeat
&& (
$prevAnnot->getRevComp() ne "C"
&& ( $currentAnnot->getHitName eq '(A)n'
|| $currentAnnot->getHitName =~ /^\(.A{3,6}\)/
|| $currentAnnot->getHitName =~ /^.?A-rich/ )
)
# Don't allow the Poly-A tail to extend beyond 30bp past the consensus length
&& ( ( $currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() ) <
( $prevAnnot->get3PrimeUnaligned() + 30 ) )
)
{
my $newend = $currentAnnot->getSeq1End();
# should not be counted as insert anymore
if ( $DEBUG ) {
print STDERR "Fusing ALU and Poly A: Current element:\n";
$currentAnnot->print();
print STDERR "will be renamed for prev element:\n";
$prevAnnot->print();
}
# TODO: Remove $k loop
#print STDERR "STRANGE>>>>>>>>WHY IS K > 1???\n"
# if ( $k > 1 );
#
# Special Case: Incompletely excised Poly-A tails
#
# Typical Case:
# ---Foo1------> AAAAAAAA -Foo1->
#
# Should be resolved as:
# ------------Foo1-------------->
#
if ( $prevAnnot->getRightLinkedHit() ) {
my $nextInChain = $prevAnnot->getRightLinkedHit();
if ( $nextInChain->getSW() eq $prevAnnot->getSW()
&& $nextInChain->getSeq1Beg() - $currentAnnot->getSeq1End() < 5
&& $nextInChain->getSeq2End() - $nextInChain->getSeq2Beg() +
1 <= 40
&& $nextInChain == $nextAnnot )
{
# To resolve this we will remove the $prevAnnot and $nextAnnot while
# converting the $currentAnnot to the final annotation.
# Save original 'derived from' annotations
if ( $options{'source'} ) {
$currentAnnot->addDerivedFromAnnot( $prevAnnot );
$currentAnnot->addDerivedFromAnnot( $nextAnnot );
}
# Copy all data fields from $prevAnnot over
$currentAnnot->setFrom( $prevAnnot );
# Copy over new Seq1End from $nextAnnot
$currentAnnot->setSeq1End( $nextAnnot->getSeq1End() );
$currentAnnot->setLeftOver( $nextAnnot->getLeftOver() );
# Set the new seq2End to max
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() +
$currentAnnot->get3PrimeUnaligned() );
# Clear out unaligned field
$currentAnnot->set3PrimeUnaligned( 0 );
# Remove $past, and $next
my $removedAnnot = $backIter->remove();
$pastAnnot = undef;
if ( $DEBUG ) {
print STDERR "Removing: ";
$removedAnnot->print();
}
# Fix joins
if ( $removedAnnot->getLeftLinkedHit() ) {
my $leftLinkedHit = $removedAnnot->getLeftLinkedHit();
$leftLinkedHit->setRightLinkedHit( $currentAnnot );
$currentAnnot->setLeftLinkedHit( $leftLinkedHit );
}
$removedAnnot = $forwIter->remove();
if ( $DEBUG ) {
print STDERR "Removing: ";
$removedAnnot->print();
}
if ( $removedAnnot->getRightLinkedHit() ) {
my $rightLinkedHit = $removedAnnot->getRightLinkedHit();
$rightLinkedHit->setLeftLinkedHit( $currentAnnot );
$currentAnnot->setRightLinkedHit( $rightLinkedHit );
}
if ( $DEBUG ) {
print STDERR "Final call:\n";
$currentAnnot->print();
}
}
}
else {
# Save original elements
$currentAnnot->addDerivedFromAnnot( $prevAnnot )
if ( $options{'source'} );
# Copy most data fields from $prevAnnot
$currentAnnot->setFrom( $prevAnnot );
if ( $prevAnnot->getLeftLinkedHit() ) {
my $prevInChain = $prevAnnot->getLeftLinkedHit();
$currentAnnot->setLeftLinkedHit( $prevInChain );
$prevInChain->setRightLinkedHit( $currentAnnot );
}
$currentAnnot->setSeq1End( $newend )
if ( $currentAnnot->getSeq1End() < $newend );
# This is now always the case; used to be that
# interrupted IRs were "broken up" after this routine
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() +
$currentAnnot->get3PrimeUnaligned() );
$currentAnnot->set3PrimeUnaligned( 0 );
#$prevAnnot->removeFromJoins();
if ( $DEBUG ) {
print STDERR "Removing: ";
$prevAnnot->print();
}
$backIter->remove();
$pastAnnot = undef;
if ( $DEBUG ) {
print STDERR "Final call:\n";
$currentAnnot->print();
print STDERR "and its links:\n";
$currentAnnot->printLinks();
if ( $currentAnnot->getLeftLinkedHit() ) {
print STDERR "foo:\n";
$currentAnnot->getLeftLinkedHit()->printLinks();
}
}
}
last;
# Reverse strand equivalent
}
elsif (
$nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $nextAnnot->getRevComp() eq 'C'
&& $nextAnnot->getSeq1Beg() - $currentAnnot->getSeq1End() < 4
&& ( $nextAnnot->getSeq2Name() =~ /^Alu|^FLAM/
&& $nextAnnot->get3PrimeUnaligned() <= 32
|| $nextAnnot->getSeq2Name() =~ /^FR?AM$|^L1.*/
&& $nextAnnot->get3PrimeUnaligned() < 26 )
&& ( $currentAnnot->getHitName eq '(T)n'
|| $currentAnnot->getHitName =~ /^\(T{3,6}.\)/
|| $currentAnnot->getHitName =~ /^.?T-rich/ )
# Don't allow the Poly-A tail to extend beyond 30bp past the consensus length
&& ( ( $currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() ) <
( $nextAnnot->get3PrimeUnaligned() + 30 ) )
)
{
my $newbegin = $currentAnnot->getSeq1Beg();
if ( $DEBUG ) {
print STDERR "Fusing ALU and Poly A: Current element:\n";
$currentAnnot->print();
print STDERR "will be renamed for next element:\n";
$nextAnnot->print();
}
#
# Special Case: Incompletely excised Poly-A tails
#
# Typical Case:
# <-Foo1- AAAAAAAA <-------Foo1--------
#
# Should be resolved as:
# <------------Foo1--------------------
#
if ( $nextAnnot->getLeftLinkedHit() ) {
my $nextInChain = $nextAnnot->getLeftLinkedHit();
if ( $nextInChain->getSW() eq $nextAnnot->getSW()
&& $nextInChain->getSeq1End() - $currentAnnot->getSeq1Beg() < 5
&& $nextInChain->getSeq2End() - $nextInChain->getSeq2Beg() +
1 <= 40
&& $nextInChain == $prevAnnot )
{
# To resolve this we will remove the $prevAnnot and $nextAnnot while
# converting the $currentAnnot to the final annotation.
# Save original 'derived from' annotations
if ( $options{'source'} ) {
$currentAnnot->addDerivedFromAnnot( $prevAnnot );
$currentAnnot->addDerivedFromAnnot( $nextAnnot );
}
# Copy all data fields from $nextAnnot over
$currentAnnot->setFrom( $nextAnnot );
# Copy over new Seq1Beg from $nextAnnot
$currentAnnot->setSeq1Beg( $nextInChain->getSeq1Beg() );
$currentAnnot->setLeftOver( $nextAnnot->getLeftOver() );
# Set the new seq2End to max
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() +
$currentAnnot->get3PrimeUnaligned() );
# Clear out unaligned field
$currentAnnot->set3PrimeUnaligned( 0 );
# Remove $past, and $next
my $removedAnnot = $backIter->remove();
$pastAnnot = undef;
if ( $DEBUG ) {
print STDERR "Removing: ";
$removedAnnot->print();
}
$removedAnnot = $forwIter->remove();
if ( $DEBUG ) {
print STDERR "Removing: ";
$removedAnnot->print();
}
$currentAnnot->setRightLinkedHit( $nextInChain );
$nextInChain->setLeftLinkedHit( $currentAnnot );
if ( $DEBUG ) {
print STDERR "Final call:\n";
$currentAnnot->print();
}
}
}
else {
# Save original elements
$currentAnnot->addDerivedFromAnnot( $nextAnnot )
if ( $options{'source'} );
# Copy most data fields from $nextAnnot
$currentAnnot->setFrom( $nextAnnot );
if ( $nextAnnot->getRightLinkedHit() ) {
my $nextInChain = $nextAnnot->getRightLinkedHit();
$currentAnnot->setRightLinkedHit( $nextInChain );
$nextInChain->setLeftLinkedHit( $currentAnnot );
}
if ( $nextAnnot->getLeftLinkedHit() ) {
my $prevInChain = $nextAnnot->getLeftLinkedHit();
$currentAnnot->setLeftLinkedHit( $prevInChain );
$prevInChain->setRightLinkedHit( $currentAnnot );
}
# Clear original alignment data ( now under derived )
#$currentAnnot->setAlignData( undef );
# It seems better to adjust Seq2End to the end of
# the consensus instead. This must (almost) always be
# reached (maximally 25 bp unaligned to start; minimum
# lenht of deleted simple repeat is 21 bp) and it is
# confusing that IR consensus sequences appear to have
# different lengths in the output (which you get with
# the commented-out line).
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() +
$currentAnnot->get3PrimeUnaligned() );
$currentAnnot->setSeq1Beg( $newbegin );
$currentAnnot->set3PrimeUnaligned( 0 );
my $LeftOver = $currentAnnot->getLeftOver();
$LeftOver =~ tr/[\(\)]//d;
$currentAnnot->setLeftOver( $LeftOver );
my $removedAnnot = $forwIter->remove();
if ( $DEBUG ) {
print STDERR " REMOVED: ";
$removedAnnot->print();
}
last;
}
}
# What does this do?
my $ClassName = $currentAnnot->getClassName();
$ClassName =~ s/_[no][el][dw](\d{1,2})?$//;
$currentAnnot->setClassName( $ClassName );
++$k;
} # While ( $k < 5 ) loop
} # Join poly-A tails to SINE or LINE1 annotations
#
# Join Alu and L1 fragments broken by clipped-out A-rich simple
# repeats, subsequently (in the previous annotation line)
# attached to the poly A tail by above code
#
elsif ( $backIter->hasPrevious() ) {
my $prevAnnot = $backIter->previous();
my ( $prevHitName, $prevClassName ) =
split( /\#/, $prevAnnot->getSeq2Name() );
if ( $currentAnnot->getHitName eq $prevHitName
&& $currentAnnot->getSeq1Beg() - $prevAnnot->getSeq1End() == 1
&& $currentAnnot->getRevComp() eq $prevAnnot->getRevComp() )
{
if ( $currentAnnot->getRevComp() eq 'C'
&& $prevAnnot->getSeq2Beg() - $currentAnnot->getSeq2End() == 1 )
{
if ( $DEBUG ) {
print STDERR "Fusing SINE/LINE and Poly A: Current element:\n";
$currentAnnot->print();
print STDERR "will be renamed for prev element:\n";
$prevAnnot->print();
}
$currentAnnot->addDerivedFromAnnot( $prevAnnot )
if ( $options{'source'} );
$currentAnnot->setSeq1Beg( $prevAnnot->getSeq1Beg() );
$currentAnnot->setSeq2End( $prevAnnot->getSeq2End() );
$currentAnnot->set3PrimeUnaligned(
$prevAnnot->get3PrimeUnaligned() );
# Fix any previous joins to this element
$prevAnnot->removeFromJoins();
$backIter->remove();
}
}
}
#
# LINE Renaming
#
if ( $currentAnnot->getClassName() =~ /^LINE/ ) {
my $HitName = $currentAnnot->getHitName();
# Rename unresolved LINEs
$HitName =~ s/_orf2$//;
# TODO: This is a special case of an element which needs
# a portion of it's sequence masked out in a seperate stage.
# The sequence is a simple repeats which is scored too high
# otherwise. I am refering to the endX designation.
$HitName =~ s/(.*)_[35]endX?$/$1/;
$HitName =~ s/_strong$//;
# could use latter as a general tool to indicate a diagnostic fragment
# rename carnivore LINEs who's name have been adjusted
# temporarily to allow neighboring fragment recognition
if ( $HitName =~ /^L1_Ca/ ) {
$HitName =~ s/^L1_Canis0/L1_Cf/;
$HitName =~ s/^L1_Canis4/L1_Canid/;
$HitName =~ s/^L1_Canis5/L1_Canid2/;
}
$currentAnnot->setHitName( $HitName );
}
#
# Count tandemly repeated fragments of a repeat as one insert
# only recognizes constant monomers; croaks on diverged dimers
#
if (
$pastAnnot
&& $pastAnnot->getClassName() !~ /^SINE/
# SINEs are too common and often miss > 10 bp of tail
# probably safe with LINEs because of variable 5' ends
&& $currentAnnot->getSeq1Beg() - $pastAnnot->getSeq1End() < 30
&& $currentAnnot->getHitName() eq $pastAnnot->getHitName()
&& $currentAnnot->getSeq1Name() eq $pastAnnot->getSeq1Name()
&& ( $currentAnnot->getSeq2Beg() > 10
|| $currentAnnot->get3PrimeUnaligned() > 10 )
&& $currentAnnot->getSeq2Beg() - $pastAnnot->getSeq2Beg() < 15
&& $pastAnnot->getSeq2Beg() - $currentAnnot->getSeq2Beg() < 15
&& $currentAnnot->getSeq2End() - $pastAnnot->getSeq2End() < 15
&& $pastAnnot->getSeq2End() - $currentAnnot->getSeq2End() < 15
)
{
$currentAnnot->setLeftLinkedHit( $pastAnnot );
}
# Get the next annot
my $nextAnnot = undef;
if ( $cycleAnnotIter->hasNext ) {
$nextAnnot = $cycleAnnotIter->next();
$cycleAnnotIter->previous();
# NOTE: If you are going to remove anything in this
# cycle you should move back and forward so
# the last thing returned is the previous one.
$cycleAnnotIter->previous();
$cycleAnnotIter->next();
}
#
# Skip the following processing blocks if we are simple/low
#
unless ( $currentAnnot->getClassName() =~
/Low_complexity|Simple_repeat|Satellite/ )
{
#
# Adjust overlapping sequences when begin or end of one of repeats
# is probably known
# -----------
# ---------
# Does the current fragment have 4-5 bp of unaligned space
# at the end or begining? Or...is the current fragment a LINE
# a Unknown or a Composite?
if (
$currentAnnot->getRevComp eq '+'
&& ( $currentAnnot->get3PrimeUnaligned >= 4 )
|| ( $currentAnnot->getRevComp eq "C"
&& $currentAnnot->getSeq2Beg >= 5 )
|| ( $currentAnnot->getClassName =~ /^L1|^Unknown|Composite/ )
)
{
# Does the current fragment and the next fragment:
# - Have the same name?
# and - Overlap by 1 or more bp in the query?
# and - Is the next fragment a LTR or SINE or DNA?
if ( $nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End >= $nextAnnot->getSeq1Beg()
&& $currentAnnot->getSeq1End < $nextAnnot->getSeq1End()
&& ( $nextAnnot->getSeq2Name() =~ /LTR|SINE|DNA/ ) )
{
# Does the current fragment run to the end of consensus ( or close )
# at the end opposite the overlap? SINES are a special case?
if (
(
$nextAnnot->getRevComp() eq '+' && $nextAnnot->getSeq2Beg() < 5
)
|| ( $nextAnnot->getRevComp() eq "C"
&& $nextAnnot->get3PrimeUnaligned() < 4
&& $nextAnnot->getSeq2Name() !~ /SINE/ )
)
{
my $overlap =
$currentAnnot->getSeq1End - $nextAnnot->getSeq1Beg() + 1;
# Added the following checks so that we do not end up
# creating consensus positions that end before they
# begin. - RMH 2005/12/2
if ( $currentAnnot->getRevComp eq '+'
&& $currentAnnot->getSeq2End - $overlap >
$currentAnnot->getSeq2Beg )
{
$currentAnnot->setSeq2End(
$currentAnnot->getSeq2End() - $overlap );
$currentAnnot->set3PrimeUnaligned(
$currentAnnot->get3PrimeUnaligned + $overlap );
$currentAnnot->setSeq1End(
$currentAnnot->getSeq1End - $overlap );
}
elsif ( $currentAnnot->getSeq2Beg + $overlap <
$currentAnnot->getSeq2End )
{
$currentAnnot->setSeq2Beg(
$currentAnnot->getSeq2Beg() + $overlap );
$currentAnnot->setSeq1End(
$currentAnnot->getSeq1End - $overlap );
}
}
}
} # End Adjust overlapping sequences when begin...
# Same as above but in reverse????
if (
$currentAnnot->getRevComp eq '+' && ( $currentAnnot->getSeq2Beg >= 5 )
|| ( $currentAnnot->getRevComp eq "C"
&& $currentAnnot->get3PrimeUnaligned >= 4 )
|| ( $currentAnnot->getClassName =~ /^L1|^Unknown|Composite/ )
)
{
if ( $pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name
&& $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSeq1End > $pastAnnot->getSeq1End + 25 )
{
if ( $pastAnnot->getClassName() =~ /^LTR|^SINE|^DNA/ ) {
if (
(
$pastAnnot->getRevComp eq '+'
&& $pastAnnot->get3PrimeUnaligned < 4
&& $pastAnnot->getClassName =~ /^[^S]/
)
|| ( $pastAnnot->getRevComp eq "C"
&& $pastAnnot->getSeq2Beg < 5 )
)
{
my $overlap =
$pastAnnot->getSeq1End - $currentAnnot->getSeq1Beg + 1;
# Added the following checks so that we do not end up
# creating consensus positions that end before they
# begin. - RMH 2005/12/2
if ( $currentAnnot->getRevComp eq '+'
&& $currentAnnot->getSeq2Beg + $overlap <
$currentAnnot->getSeq2End )
{
$currentAnnot->setSeq2Beg(
$currentAnnot->getSeq2Beg() + $overlap );
$currentAnnot->setSeq1Beg( $pastAnnot->getSeq1End + 1 );
}
elsif ( $currentAnnot->getSeq2End - $overlap >
$currentAnnot->getSeq2Beg )
{
$currentAnnot->setSeq2End(
$currentAnnot->getSeq2End - $overlap );
$currentAnnot->set3PrimeUnaligned(
$currentAnnot->get3PrimeUnaligned() + $overlap );
$currentAnnot->setSeq1Beg( $pastAnnot->getSeq1End + 1 );
}
}
}
}
}
if ( $currentAnnot->getClassName =~ /^SINE/ ) {
$currentAnnot->setClassName( "srpRNA" )
if ( $currentAnnot->getHitName eq "7SLRNA" );
$currentAnnot->setClassName( "scRNA" )
if ( $currentAnnot->getHitName eq "BC200"
|| $currentAnnot->getHitName =~ /^BC1_/ );
# $ClassName = "scRNA" if $HitName eq "BC200" && $Seq2End > 100;
if ( $currentAnnot->getHitName eq "ID_B1"
&& $currentAnnot->getSeq2End < 90 )
{
$currentAnnot->setClassName( "SINE/ID" );
$currentAnnot->setHitName( "ID" );
}
}
} # Unless ( $ClassName =~ /Low_complexity...
# get rid of negative LINE1 positions; also readjust MLT2 fragments
if ( $conPosCorrection{ $currentAnnot->getID() } ) {
# probably don't need to be so restrictive, as only those
# repeats in the following if ever obtain a $conPosCorrection vallue
if ( $currentAnnot->getClassName() =~ /^LINE/ && !$options{'orf2'}
|| $currentAnnot->getHitName() =~ /^MLT2\w\d?/
&& $currentAnnot->getHitName() =~ /^MLT2B[34]$/ )
{ # the adjusted pos are right for B3 & 4
#$currentAnnot->sanityCheckConsPos( \%conPosCorrection );
$currentAnnot->setSeq2Beg( $currentAnnot->getSeq2Beg() +
$conPosCorrection{ $currentAnnot->getID() } );
## TODO: Consider why this needs to be protected from
## producing negative/0 numbers. Considered: If the
## renaming of a fragment changes the length of the consensus
## ( making it shorter ) the adjustment will be off.
## Now consider how to fix this.
$currentAnnot->setSeq2Beg( 1 )
if ( $currentAnnot->getSeq2Beg() < 1 );
$currentAnnot->setSeq2End( $currentAnnot->getSeq2End() +
$conPosCorrection{ $currentAnnot->getID() } );
}
}
elsif ( $currentAnnot->getHitName() =~ /MER33|Charlie5/
&& $currentAnnot->getSeq2Beg < 1 )
{
$currentAnnot->setSeq2Beg( 1 );
}
# TODO Get rid of this once it's in cycle 11
my $length = $currentAnnot->getSeq1End - $currentAnnot->getSeq1Beg + 1;
## following happens sometimes with overlapping simple repeats:
if ( $nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End > $nextAnnot->getSeq1End() )
{
$length -= $nextAnnot->getSeq1End() - $nextAnnot->getSeq1Beg() + 1;
}
if ( $currentAnnot->getClassName =~ /Simple_repeat|Satellite/ ) {
$currentAnnot->setClassName( "Low_complexity" )
if ( $currentAnnot->getHitName =~ /rich|purine|pyrimidin/ );
if ( $currentAnnot->getHitName =~ /\(CATTC\)n|\(GAATG\)n/ ) {
my $hitname = quotemeta $currentAnnot->getHitName;
if (
$currentAnnot->getSeq2End > 200
|| ( $pastAnnot
&& $pastAnnot->getHitName =~ /$hitname|HSATII/
&& $currentAnnot->getSeq1Beg - $pastAnnot->getSeq1End < 100
&& $currentAnnot->getSeq2End + $pastAnnot->getSeq2End > 200 )
|| (
$nextAnnot
&& $nextAnnot->getSeq2Name() =~ /$hitname|HSATII/
&& $nextAnnot->getSeq1Beg() - $currentAnnot->getSeq1End < 100
&& (
( $currentAnnot->getSeq2End + $nextAnnot->getSeq2End() > 200 )
|| ( $pastAnnot
&& $pastAnnot->getHitName eq $currentAnnot->getHitName
&& $currentAnnot->getSeq2End + $pastAnnot->getSeq2End +
$nextAnnot->getSeq2End() > 200 )
)
)
)
{
$currentAnnot->setClassName( "Satellite" );
}
}
$currentAnnot->setHitName( $currentAnnot->getHitName() . '/Alpha' )
if ( $currentAnnot->getHitName eq 'ALR' );
$currentAnnot->setHitName( $currentAnnot->getHitName() . '/Beta' )
if ( $currentAnnot->getHitName eq 'BSR' );
if ( $pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name )
{
if ( $pastAnnot->getHitName eq $currentAnnot->getHitName
&& $pastAnnot->getRevComp eq $currentAnnot->getRevComp
&& $currentAnnot->getSeq1Beg - $pastAnnot->getSeq1End < 65 )
{
$currentAnnot->join( $pastAnnot );
}
# TODO: Get rid of this once its in cycle 11
if ( $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSeq1End > $pastAnnot->getSeq1End )
{
$length -=
( $pastAnnot->getSeq1End - $currentAnnot->getSeq1Beg + 1 );
}
}
if ( $currentAnnot->getClassName =~ /Satellite/ ) {
my $tmpClassName = $currentAnnot->getClassName();
$tmpClassName =~ s/[Cc]entromeric$/centr/;
$tmpClassName =~ s/telomeric$/telo/;
$tmpClassName =~ s/acromeric$/acro/;
$currentAnnot->setClassName( $tmpClassName );
}
} # if Simple/Sattellite
# Do not print (near) duplicates created by fusing overlapping matches
# Remove small fragments created by RM fragmentation of alignments.
if (
(
$pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End <= $pastAnnot->getSeq1End()
&& $currentAnnot->getSW <= $pastAnnot->getSW()
&& $currentAnnot->getClassName eq $pastAnnot->getClassName()
&& $currentAnnot->getLastField eq $pastAnnot->getLastField()
)
|| (
$currentAnnot->getClassName !~ /Simple/
# Removed this constraint per Arian's recommendations
#&& ! $currentAnnot->getRightLinkedHit()
#&& ! $currentAnnot->getLeftLinkedHit()
&& $currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() < 10
|| $currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() < 5
)
||
# nor low complexity DNA or simple repeats when people don't
# want to see it
(
$options{'nolow'}
&& $currentAnnot->getClassName =~ /Low_complexity|Simple_repeat/
)
)
{
if ( $DEBUG ) {
print STDERR
"Near duplicate (created by fusing): Removing Current element:\n";
$currentAnnot->print();
if ( $pastAnnot ) {
print STDERR "because of past element:\n";
$pastAnnot->print();
}
}
$currentAnnot->removeFromJoins();
$cycleAnnotIter->remove();
$pastAnnot->addDerivedFromAnnot( $currentAnnot )
if ( $pastAnnot && $options{'source'} );
next CYCLE10;
}
$pastAnnot = $currentAnnot;
} # CYCLE 10
#printHitArrayList( $sortedAnnotationsList );
&generateOutput(
\%options, \%seq1Lengths,
$file, $filename,
$dbversion, $numSearchedSeqs,
$lenSearchedSeqs, $lenSearchedSeqsExcludingXNRuns,
$versionmode, $engine,
$sortedAnnotationsList, $poundformat
);
} # else....if ( ! $poundformat
print STDERR "\ndone\n";
} # For each file
##
##
## End of main loops
##
##
#########################################################################
##subroutines
#########################################################################
#
# replaceRMFragmentChainWithRefinement:
# RepeatMasker fragments alignment's that span a ( previously )
# clipped out repeat. The RM refinement process is run prior
# to RM fragmentation and therefore creates contiguous re-alignments.
# RM does not fragment these re-alignments. If we choose to replace
# a RM fragmented alignment with a contiguous re-alignment then
# we need to fragment the re-alignment ourselves. This operation
# is highly subjective as we do not have the alignment data
# accessible to determine the breakpoint location. Here are
# a few examples of how we are doing this:
#
# Given that b1s4i3 joins to the previously joined
# RM fragmented repeat b1s6i8:
#
# +-----------+
# ---b1s4i3---> | |
# ---b1s6i8---> -----b1s6i8--->
#
# and given the relalignment:
#
# --------[b1s6i8]---------->
#
# we must fragment [b1s6i8] into something approximating the
# original fragments and then replace the original ones.
#
#
# Scenario #1: +-----------+
# | |
# RM Frags -----------------------> ---->
# Refined ......................../ /....>
#
# Replace original fragments with new ones:
# +-----------+
# | |
# .......................> ....>
#
#
# Scenario #2: +-----------+
# | |
# -----------------------> ---->
# ......................../ /.>
#
# If fragment coverage is less than 10 than remove fragment:
# .......................>
# else:
# +-----------+
# | |
# .......................> ..>
#
#
#
# Scenario #2: +-----------+
# | |
# -----------------------> ---->
# .....................>
#
# Remove uncovered fragment
# .....................>
#
sub replaceRMFragmentChainWithRefinement {
my $rightAnnot = shift;
my $rightEquiv = shift;
my $DEBUG = 0;
my $chainCATID = $rightAnnot->getCATID();
print STDERR "replaceRMFragmentChainWithRefinement: Entered...\n"
if ( $DEBUG );
# Make sure we are at the begining of the chain before we attempt to
# replace with the refinement annotation.
while ( $rightAnnot->getLeftLinkedHit() ) {
if ( $rightAnnot->getLeftLinkedHit()->getCATID() eq $chainCATID ) {
$rightAnnot = $rightAnnot->getLeftLinkedHit();
}
else {
last;
}
}
my $newSeq1Width = $rightEquiv->getSeq1End() - $rightEquiv->getSeq1Beg() + 1;
my $newConsSize =
$rightEquiv->getSeq2End() + $rightEquiv->get3PrimeUnaligned();
my $newConsLeft = $rightEquiv->getSeq2Beg();
my $newConsPerSeq1 =
( $rightEquiv->getSeq2End() - $rightEquiv->getSeq2Beg() + 1 ) /
$newSeq1Width;
my $currentLinearFragPos = $rightAnnot->getSeq1Beg();
while ( 1 ) {
if ( $DEBUG ) {
print STDERR " Fix frag starting chain: ";
$rightAnnot->print();
print STDERR " With this one: ";
$rightEquiv->print();
print STDERR " Current linear frag pos = $currentLinearFragPos\n";
}
if (
(
$rightAnnot->getSeq1Beg() <= $rightEquiv->getSeq1Beg()
&& $rightAnnot->getSeq1End() - $rightEquiv->getSeq1Beg() < 10
)
|| $rightEquiv->getSeq1End() - $currentLinearFragPos < 10
)
{
print STDERR " Marking as deleted\n" if ( $DEBUG );
# NOTE: This is a bit of a synthetic removal. Since we do not have the
# arraylist and it's iterators all we can do is simply alter the
# annotation to have a 0 length seq1Length and a silly name like
# "DELETE_ME. In subsequent cycles 0 length repeats get removed.
$rightAnnot->setSeq1End( $rightAnnot->setSeq1Beg() );
$rightAnnot->setHitName( "DELETE_ME" );
}
else {
# Fix Seq1End for last fragment
if ( $currentLinearFragPos +
( $rightAnnot->getSeq1End() - $rightAnnot->getSeq1Beg() + 1 ) >
$rightEquiv->getSeq1End() )
{
$rightAnnot->setSeq1End( $rightAnnot->getSeq1Beg() +
( $rightEquiv->getSeq1End() - $currentLinearFragPos ) );
$rightAnnot->setLeftOver( $rightEquiv->getLeftOver() );
}
# Fix Seq1Beg for first fragment
if ( $rightAnnot->getSeq1Beg() < $rightEquiv->getSeq1Beg() ) {
$rightAnnot->setSeq1Beg( $rightEquiv->getSeq1Beg() );
}
my $newConsWidth =
int( ( $rightAnnot->getSeq1End() - $rightAnnot->getSeq1Beg() + 1 ) *
$newConsPerSeq1 );
$rightAnnot->setSeq2Beg( $newConsLeft );
$newConsLeft += $newConsWidth;
$newConsLeft = $rightEquiv->getSeq2End()
if ( $newConsLeft > $rightEquiv->getSeq2End() );
$rightAnnot->setSeq2End( $newConsLeft );
$rightAnnot->set3PrimeUnaligned( $newConsSize - $newConsLeft );
$newConsLeft++;
$rightAnnot->setHitName( $rightEquiv->getHitName() );
$rightAnnot->setSW( $rightEquiv->getSW() );
$rightAnnot->setPctSubst( $rightEquiv->getPctSubst() );
$rightAnnot->setPctDelete( $rightEquiv->getPctDelete() );
$rightAnnot->setPctInsert( $rightEquiv->getPctInsert() );
$rightAnnot->setSeq1Name( $rightEquiv->getSeq1Name() );
$rightAnnot->setRevComp( $rightEquiv->getRevComp() );
$rightAnnot->setClassName( $rightEquiv->getClassName() );
}
last
if ( !$rightAnnot->getRightLinkedHit()
|| $rightAnnot->getRightLinkedHit()->getCATID() ne $rightAnnot->getCATID()
);
$currentLinearFragPos +=
( $rightAnnot->getSeq1End() - $rightAnnot->getSeq1Beg + 1 );
$rightAnnot = $rightAnnot->getRightLinkedHit();
}
print STDERR "replaceRMFragmentChainWithRefinement: Leaving...\n"
if ( $DEBUG );
}
#
# getRefinedHighScore:
# Given a RM annotation that has associated refinement ( re-alignment ) data,
# return the highest re-alignment score in the refinement set.
#
sub getRefinedHighScore {
my $collection = shift;
my $highScore = 0;
if (
defined( my $refHashEntry = $refinementHash{ $collection->getCATID() } ) )
{
foreach my $hitName ( keys %{$refHashEntry} ) {
my $refArray = $refHashEntry->{$hitName};
foreach my $hit ( @{$refArray} ) {
$highScore = $hit->getSW() if ( $highScore < $hit->getSW() );
}
}
}
return $highScore;
}
#
# getMatchingRefinedEntries:
# Given a RM annotation that has associated refinement ( re-alignment ) data,
# return the re-alignment(s) for a given consensus ID. NOTE: The consensus
# ID is passed in the form of a annotation. Also note that the routine may
# not return any match.
#
sub getMatchingRefinedEntries {
my $collection = shift;
my $annot = shift;
$annot = $collection if ( !defined $annot );
if (
defined( my $refHashEntry = $refinementHash{ $collection->getCATID() } ) )
{
if ( defined( my $refArray = $refHashEntry->{ $annot->getHitName() } ) ) {
return @{$refArray};
}
}
return ();
}
#
# getMatchingRefinedEntry:
# Given a RM annotation that has associated refinement ( re-alignment ) data,
# return the equivalent re-alignment ( same ID as the RM annotation ) annotation
# or the highest scoring equivalent if more than one re-alignment annotation is
# found.
#
sub getMatchingRefinedEntry {
my $annot = shift;
my $match;
if ( defined( my $refHashEntry = $refinementHash{ $annot->getCATID() } ) ) {
if ( defined( my $refArray = $refHashEntry->{ $annot->getHitName() } ) ) {
my $highScore = 0;
foreach my $refinedAnnot ( @{$refArray} ) {
if ( $refinedAnnot->getSW() > $highScore ) {
$highScore = $refinedAnnot->getSW();
$match = $refinedAnnot;
}
}
}
}
return $match;
}
#
# getEquivArray:
# Given a RM annotation that has associated refinement ( re-alignment ) data,
# return all re-alignments to all consensi for this annotation.
#
sub getEquivArray {
my $annot = shift;
my @annots = ();
if ( defined( my $refHashEntry = $refinementHash{ $annot->getCATID() } ) ) {
foreach my $key ( keys %{$refHashEntry} ) {
push @annots, ( @{ $refHashEntry->{$key} } );
}
}
return @annots;
}
#
# Final output routine
#
sub generateOutput {
my %options = %{ shift() };
my %seq1Lengths = %{ shift() };
my $file = shift;
my $filename = shift;
my $dbversion = shift;
my $numSearchedSeqs = shift;
my $lenSearchedSeqs = shift;
my $lenSearchedSeqsExcludingXNRuns = shift;
my $versionmode = shift;
my $engine = shift;
my $sortedAnnotationsList = shift;
my $poundformat = shift;
print STDERR "\nGenerating output... ";
my $i = -1;
my $cycleAnnotIter = $sortedAnnotationsList->getIterator();
my $DEBUG = 0;
# Local to cycle
my $lastid = 0;
my $pastAnnot;
# Globals created for stats
my %totlength = ();
my %uniqCount = ();
my %checked = ();
my $seq_cnt = 0;
my $frac_GC = 0;
my $totseqlen = 0;
my $nonNSeqLen = 0;
my $totalSeqLen = 0;
my $maskedpercent = 0;
my $maskedlength = 0;
my $annotatedlength = 0;
# Aggregate Stats ( Default match is to "OTHER" )
my %aggregateStats = (
'SINE' => { 'RE' => 'SINE' },
'LINE' => { 'RE' => '^LINE' },
'LINECR1' => { 'RE' => '\/CR1$|\/L2$|\/Rex-Babar$' },
'LINEI' => { 'RE' => '\/R1$|\/LOA$|\/I$|\/Jockey$' },
'LINERTE' => { 'RE' => '\/RTE|\/Bov-B' },
'LINER2' => { 'RE' => '\/NeSL|\/R[24]|\/Dong' },
'LTR' => { 'RE' => '^LTR' },
'LTRERV' => { 'RE' => 'ERV|ERVL-MaLR' },
'LTRBEL' => { 'RE' => 'Pao$' },
'LTRGYP' => { 'RE' => 'DIRS$|Gypsy$' },
'DNA' => { 'RE' => '^DNA' },
'DNATC1' => { 'RE' => '\/TcMar|\/Stowaway' },
'DNAHAT' => { 'RE' => '\/[hH]AT|Tam3$' },
'DNAPIG' => { 'RE' => '\/T2$|\/PiggyBac' },
'DNAH' => { 'RE' => 'Harbing|Tourist' },
'DNAP' => { 'RE' => '\/P$|\/Mirage|\/Transib' },
'OTHER' => { 'RE' => '^Unknown|^Composite|^Other' },
'RNA' => { 'RE' => 'RNA$' },
'SATEL' => { 'RE' => 'Satel' },
'SIMPLE' => { 'RE' => 'Simple' },
'LOWCOMP' => { 'RE' => '^Low' },
);
# calculate stats
while ( $cycleAnnotIter->hasNext() ) {
$i++;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
#
# Stats
#
my $CN = $currentAnnot->getClassName();
$CN =~ s/\?$//; # I'm counting them with the class, even if I'm not sure
if ( !defined $uniqCount{$CN} ) {
$uniqCount{$CN} = 0;
$totlength{$CN} = 0 if !defined $totlength{$CN};
}
# Define length of coverage based on possibly overlapping
# fragments.
my $length = $currentAnnot->getSeq1End - $currentAnnot->getSeq1Beg + 1;
if ( $pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name()
&& $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSeq1End > $pastAnnot->getSeq1End )
{
$length -= ( $pastAnnot->getSeq1End - $currentAnnot->getSeq1Beg + 1 );
}
# Determine if this is fragment of a previously counted element
my $checked = 0;
if ( $currentAnnot->getLeftLinkedHit()
&& $currentAnnot->getLeftLinkedHit() != $currentAnnot )
{
$checked = 1;
}
# Class Name Stats
$uniqCount{$CN}++ unless $checked;
$totlength{$CN} += $length;
$annotatedlength += $length;
# Aggregate Stats
my $cataloged = 0;
foreach my $aggKey ( keys( %aggregateStats ) ) {
my $regExp = $aggregateStats{$aggKey}->{'RE'};
if ( $CN =~ /$regExp/ ) {
$aggregateStats{$aggKey}->{'count'}++ unless $checked;
$aggregateStats{$aggKey}->{'length'} += $length;
$cataloged = 1;
}
}
if ( !$cataloged ) {
$aggregateStats{'OTHER'}->{'count'}++ unless $checked;
$aggregateStats{'OTHER'}->{'length'} += $length;
}
$checked{ $currentAnnot->getID() }++;
$pastAnnot = $currentAnnot;
}
#
# Now go through the dataset and renumber the ids
#
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
my %id = ();
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
#
# Build the id{} datastructure for renumbering the annotations
#
print STDERR "About to renumber\n" if ( $DEBUG );
my $tmpID = $currentAnnot->getID();
$currentAnnot->print() if ( $DEBUG );
if ( $currentAnnot->getLeftLinkedHit()
&& $currentAnnot->getLeftLinkedHit() != $currentAnnot )
{
if ( $DEBUG ) {
print STDERR "Left link is:\n";
$currentAnnot->getLeftLinkedHit()->print();
print STDERR "Setting to left's id{ "
. $currentAnnot->getLeftLinkedHit()->getID() . " } = "
. $id{ $currentAnnot->getLeftLinkedHit()->getID() } . "\n";
}
$id{$tmpID} = $id{ $currentAnnot->getLeftLinkedHit()->getID() };
}
else {
print STDERR "Setting to new number $lastid + 1\n" if ( $DEBUG );
$id{$tmpID} = ++$lastid;
}
} # End while
#printHitArrayList( $sortedAnnotationsList );
##
## Annotation Output
##
# Get column widths
my %colWidths = &getMaxColWidths( $sortedAnnotationsList );
# Some option to do this
if ( $options{'html'} ) {
&printHTMLAnnots( "$file.out.html", \%id, \%seq1Lengths, \%colWidths,
$sortedAnnotationsList );
}
if ( $options{'a'} ) {
&printAlignAnnots( "$file.align", \%id, \%seq1Lengths, \%colWidths,
$sortedAnnotationsList );
}
#
# Print the out, xm, ace, poly and gff files
#
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
my $headerWritten = 0;
my $pastAnnot = undef;
open( OUTFULL, ">$file.out" ) || die "can't create $file.out\n";
$options{'xm'}
&& ( open( OUTXM, ">$file.out.xm" )
|| die "can't create $file.out.xm\n" );
$options{'ace'}
&& ( open( OUTACE, ">$file.out.ace" )
|| die "can't create $file.out.ace\n" );
$options{'poly'}
&& ( open( OUTPOLY, ">$file.polyout" )
|| die "can't create $file.out.polyout\n" );
if ( $options{'gff'} ) {
open( OUTGFF, ">$file.out.gff" ) || die "can't create $file.out.gff\n";
print OUTGFF "##gff-version 2\n";
printf OUTGFF "##date %4d-%02d-%02d\n", ( localtime )[ 5 ] + 1900,
( localtime )[ 4 ] + 1, ( localtime )[ 3 ]; # date as 1999-09-24...
( my $seqname = $file ) =~ s/^.*\///;
print OUTGFF "##sequence-region $seqname\n";
}
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
# Get the next annot
my $nextAnnot = undef;
if ( $cycleAnnotIter->hasNext ) {
$nextAnnot = $cycleAnnotIter->next();
$cycleAnnotIter->previous();
# NOTE: If you are going to remove anything in this
# cycle you should move back and forward so
# the last thing returned is the previous one.
}
#
# Indicate overlapping sequences in table
#
my $Overlapped = "";
if (
(
$pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name
&& $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSW < $pastAnnot->getSW
&& $currentAnnot->getLastField eq $pastAnnot->getLastField
)
|| ( $nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End >= $nextAnnot->getSeq1Beg()
&& $currentAnnot->getSW < $nextAnnot->getSW()
&& $currentAnnot->getLastField eq $nextAnnot->getLastField() )
)
{
$Overlapped = "*";
}
# format fields
my $LeftOver =
$seq1Lengths{ $currentAnnot->getSeq1Name } - $currentAnnot->getSeq1End;
my $LeftOverPrint = "(" . $LeftOver . ")";
my $Seq2BeginPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
my $LeftUnalignedPrint = $currentAnnot->getSeq2Beg();
if ( $currentAnnot->getRevComp eq '+' ) {
$Seq2BeginPrint = $currentAnnot->getSeq2Beg();
$LeftUnalignedPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
}
my $printid = $id{ $currentAnnot->getID() };
if ( $options{'no_id'} ) {
$printid = "";
}
my $PctSubst = sprintf "%4.1f", $currentAnnot->getPctSubst;
my $PctDelete = sprintf "%4.1f", $currentAnnot->getPctDelete;
my $PctInsert = sprintf "%4.1f", $currentAnnot->getPctInsert;
if ( $options{'xm'} ) {
print OUTXM ""
. $currentAnnot->getSW() . " "
. $PctSubst . " "
. $PctDelete . " "
. $PctInsert . " "
. $currentAnnot->getSeq1Name() . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " "
. $LeftOverPrint . " "
. $currentAnnot->getRevComp() . " "
. $currentAnnot->getHitName() . "\#"
. $currentAnnot->getClassName() . " "
. $Seq2BeginPrint . " "
. $currentAnnot->getSeq2End() . " "
. $LeftUnalignedPrint . " "
. $Overlapped . "\n";
}
if ( $options{'ace'} ) {
if ( $currentAnnot->getRevComp eq "C" ) {
print OUTACE "Motif_homol \""
. $currentAnnot->getHitName()
. "\" \"RepeatMasker\" "
. $PctSubst . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " - "
. $currentAnnot->getSeq2End() . " "
. $currentAnnot->getSeq2Beg() . "\n";
}
else {
print OUTACE "Motif_homol \""
. $currentAnnot->getHitName()
. "\" \"RepeatMasker\" "
. $PctSubst . " "
. $currentAnnot->getSeq1Beg() . " "
. $currentAnnot->getSeq1End() . " + "
. $currentAnnot->getSeq2End() . " "
. $currentAnnot->getSeq2Beg() . "\n";
}
}
if ( $options{'poly'}
&& $currentAnnot->getClassName eq "Simple_repeat"
&& $PctSubst + $PctDelete + $PctInsert < 10 )
{
printf OUTPOLY "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s %1s\n", $currentAnnot->getSW(),
$PctSubst, $PctDelete, $PctInsert, $currentAnnot->getSeq1Name(),
$currentAnnot->getSeq1Beg(), $currentAnnot->getSeq1End(),
$LeftOverPrint, $currentAnnot->getRevComp(),
$currentAnnot->getHitName(), $currentAnnot->getClassName(),
$Seq2BeginPrint, $currentAnnot->getSeq2End(), $LeftUnalignedPrint,
$Overlapped;
} # if $options{'poly'}
if ( $options{'gff'} ) {
my $source;
if ( $currentAnnot->getHitName =~ /Alu/ ) {
$source = 'RepeatMasker_SINE';
}
else {
$source = 'RepeatMasker';
}
print OUTGFF ""
. $currentAnnot->getSeq1Name() . "\t"
. $source
. "\tsimilarity\t"
. $currentAnnot->getSeq1Beg() . "\t"
. $currentAnnot->getSeq1End() . "\t"
. $PctSubst . "\t";
if ( $currentAnnot->getRevComp() eq "C" ) {
print OUTGFF "-\t.\t";
}
else {
print OUTGFF "+\t.\t";
}
print OUTGFF "Target \"Motif:"
. $currentAnnot->getHitName() . "\" "
. $currentAnnot->getSeq2Beg() . " "
. $currentAnnot->getSeq2End() . "\n";
}
if ( !$headerWritten ) {
my $widthposquery = $colWidths{'BeginAlign'} + $colWidths{'EndAlign'} +
$colWidths{'LeftOver'} + 2;
my $widthposrepeat = $colWidths{'Seq2Begin'} + $colWidths{'Seq2End'} +
$colWidths{'LeftUnaligned'} + 2;
# First line of header
printf OUTFULL "%${colWidths{'SW'}}s %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%-${widthposquery}s "
. "%-${colWidths{'HitName'}}s %-${colWidths{'class'}}s "
. "%${widthposrepeat}s\n", 'SW', 'perc', 'perc', 'perc', 'query',
'position in query', 'matching', 'repeat', 'position in repeat';
# Second line of header
printf OUTFULL "%${colWidths{'SW'}}s %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%-${colWidths{'BeginAlign'}}s "
. "%-${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%-${colWidths{'Seq2Begin'}}s "
. "%-${colWidths{'Seq2End'}}s "
. "%-${colWidths{'LeftUnaligned'}}s ", 'score', 'div.', 'del.',
'ins.', 'sequence', 'begin', 'end', '(left)', 'repeat',
'class/family', 'begin', 'end', '(left)', 'ID';
unless ( $options{'no_id'} ) {
printf OUTFULL "%${colWidths{'ID'}}s", 'ID';
}
printf OUTFULL "\n\n";
$headerWritten = 1;
}
if ( $options{'lcambig'} ) {
# Use repeat name case to highlight ambiguous DNA
# transposon fragments
$currentAnnot->setHitName( uc( $currentAnnot->getHitName() ) );
$currentAnnot->setHitName( lc( $currentAnnot->getHitName() ) )
if ( $currentAnnot->getEquivHash()
&& $currentAnnot->getClassName() =~ /DNA/ );
}
printf OUTFULL "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s ", $currentAnnot->getSW(), $PctSubst,
$PctDelete, $PctInsert, $currentAnnot->getSeq1Name(),
$currentAnnot->getSeq1Beg(), $currentAnnot->getSeq1End(),
$LeftOverPrint, $currentAnnot->getRevComp(),
$currentAnnot->getHitName(), $currentAnnot->getClassName(),
$Seq2BeginPrint, $currentAnnot->getSeq2End(), $LeftUnalignedPrint;
unless ( $options{'no_id'} ) {
printf OUTFULL "%${colWidths{'ID'}}s %1s\n", $printid, $Overlapped;
}
else {
printf OUTFULL "%1s\n", $Overlapped;
}
## TESTING
##if ( $alignFileData )
##{
##}
# Currently only available in html output
#if ( $options{'source'} ) {
# #print STDERR "Doing source output\n";
# printSourceAnnots( $currentAnnot, \%colWidths, 1 );
#}
$pastAnnot = $currentAnnot;
} # while loop
close OUTFULL;
close OUTXM if $options{'xm'};
close OUTACE if $options{'ace'};
close OUTGFF if $options{'gff'};
close OUTPOLY if $options{'poly'};
##
## Table Output
##
#
# Now mask so we can get stats on the seq for the table output
#
# GLOBAL for use in format statements
my $usePerc = 1;
my $exclnote = "";
if ( -f $options{'maskSource'} ) {
print STDERR "\nmasking";
my $db = FastaDB->new(
fileName => $options{'maskSource'},
openMode => SeqDBI::ReadOnly,
maxIDLength => 50
);
my $maskFormat = '';
$maskFormat = 'x' if ( $options{'x'} );
$maskFormat = 'xsmall' if ( $options{'xsmall'} );
( $seq_cnt, $totseqlen, $nonNSeqLen, $frac_GC, $maskedlength ) =
&maskSequence( $maskFormat, $db, "$file.out",
$options{'maskSource'} . ".masked" );
$totalSeqLen = $totseqlen;
if ( $options{'excln'} ) {
$totseqlen = $nonNSeqLen;
$exclnote = "Runs of >=20 X/Ns in query were excluded in % calcs\n";
}
$nonNSeqLen = "($nonNSeqLen bp excl N/X-runs)";
$maskedpercent = ( $maskedlength / $totseqlen ) * 100;
}
elsif ( $numSearchedSeqs ) {
$seq_cnt = $numSearchedSeqs;
$totseqlen = $lenSearchedSeqs;
if ( $options{'excln'} ) {
$totseqlen = $lenSearchedSeqsExcludingXNRuns;
$exclnote = "Runs of >=20 X/Ns in query were excluded in % calcs\n";
}
$totalSeqLen = $totseqlen;
$nonNSeqLen = "($lenSearchedSeqsExcludingXNRuns bp excl N/X-runs)";
$maskedlength = $annotatedlength;
$maskedpercent = ( $maskedlength / $totseqlen ) * 100;
$frac_GC = "Unknown";
}
else {
warn "\nWarning: Calculation of statistics hampered by missing\n"
. "sequence sizes in the input file *and* missing -maskSource\n"
. "parameter! Cannot calculate percentage masked values.\n";
$usePerc = 0;
$totseqlen = 1;
$nonNSeqLen = "";
$maskedpercent = 0;
$maskedlength = $annotatedlength;
}
my $totallength =
$aggregateStats{'SINE'}->{'length'} +
$aggregateStats{'LINE'}->{'length'} + $aggregateStats{'LTR'}->{'length'} +
$aggregateStats{'DNA'}->{'length'} + $aggregateStats{'OTHER'}->{'length'};
my $customLib;
if ( $options{'lib'} ) {
$options{'lib'} =~ s/.*(\/.*?$)/\.\.\.$1/; # full path too long
# obnoxiously, emacs' indentation can't handle that line;
# nothing wrong
$customLib = "The query was compared to ";
if ( $poundformat ) {
$customLib .= "classified sequences in ";
}
else {
$customLib .= "unclassified sequences in ";
}
$customLib = $customLib . "\"" . $options{'lib'} . "\"";
}
# future aim is to use same format for at least all mammals
if ( $options{'primate'} ) {
my $OUT;
open( $OUT, ">$file.tbl" )
|| die "can't create $file.tbl\n";
printf $OUT "==================================================\n";
printf $OUT "file name: %-25s\n", $filename;
printf $OUT "sequences: %7d\n", $seq_cnt;
printf $OUT "total length: %10d bp %-25s\n", $totalSeqLen, $nonNSeqLen;
printf $OUT "GC level: %6s \%\n", $frac_GC;
printf $OUT "bases masked: %10d bp ( %4.2f \%)\n", $maskedlength,
$maskedpercent;
printf $OUT "==================================================\n";
printf $OUT " number of length percentage\n";
printf $OUT " elements* occupied of sequence\n";
printf $OUT "--------------------------------------------------\n";
printf $OUT "SINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SINE'}->{'count'}, $aggregateStats{'SINE'}->{'length'},
$aggregateStats{'SINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " ALUs %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/Alu"}, $totlength{"SINE/Alu"},
$totlength{"SINE/Alu"} * 100 * $usePerc / $totseqlen;
printf $OUT " MIRs %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/MIR"}, $totlength{"SINE/MIR"},
$totlength{"SINE/MIR"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINE'}->{'count'}, $aggregateStats{'LINE'}->{'length'},
$aggregateStats{'LINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L1"}, $totlength{"LINE/L1"},
$totlength{"LINE/L1"} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE2 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L2"}, $totlength{"LINE/L2"},
$totlength{"LINE/L2"} * 100 * $usePerc / $totseqlen;
printf $OUT " L3/CR1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/CR1"}, $totlength{"LINE/CR1"},
$totlength{"LINE/CR1"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LTR elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTR'}->{'count'}, $aggregateStats{'LTR'}->{'length'},
$aggregateStats{'LTR'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL"}, $totlength{"LTR/ERVL"},
$totlength{"LTR/ERVL"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL-MaLRs %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL-MaLR"}, $totlength{"LTR/ERVL-MaLR"},
$totlength{"LTR/ERVL-MaLR"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classI %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERV1"}, $totlength{"LTR/ERV1"},
$totlength{"LTR/ERV1"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classII%6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVK"}, $totlength{"LTR/ERVK"},
$totlength{"LTR/ERVK"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "DNA elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNA'}->{'count'}, $aggregateStats{'DNA'}->{'length'},
$aggregateStats{'DNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " hAT-Charlie %6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/hAT-Charlie"}, $totlength{"DNA/hAT-Charlie"},
$totlength{"DNA/hAT-Charlie"} * 100 * $usePerc / $totseqlen;
printf $OUT " TcMar-Tigger%6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/TcMar-Tigger"}, $totlength{"DNA/TcMar-Tigger"},
$totlength{"DNA/TcMar-Tigger"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Unclassified: %6d %10d bp %5.2f \%\n",
$aggregateStats{'OTHER'}->{'count'},
$aggregateStats{'OTHER'}->{'length'},
$aggregateStats{'OTHER'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Total interspersed repeats:%9d bp %5.2f \%\n", $totallength,
$totallength * 100 * $usePerc / $totseqlen;
printf $OUT "\n\n";
printf $OUT "Small RNA: %6d %10d bp %5.2f \%\n",
$aggregateStats{'RNA'}->{'count'}, $aggregateStats{'RNA'}->{'length'},
$aggregateStats{'RNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Satellites: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SATEL'}->{'count'},
$aggregateStats{'SATEL'}->{'length'},
$aggregateStats{'SATEL'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Simple repeats: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SIMPLE'}->{'count'},
$aggregateStats{'SIMPLE'}->{'length'},
$aggregateStats{'SIMPLE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Low complexity: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LOWCOMP'}->{'count'},
$aggregateStats{'LOWCOMP'}->{'length'},
$aggregateStats{'LOWCOMP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "==================================================\n";
printf $OUT "\n";
printf $OUT "* most repeats fragmented by insertions or deletions\n";
printf $OUT " have been counted as one element\n";
printf $OUT "%54s\n", $exclnote;
printf $OUT "\n";
printf $OUT "The query species was assumed to be %-14s\n",
$options{'species'};
printf $OUT "%-82s\n", substr( $versionmode, 0, 82 );
printf $OUT "$engine\n";
printf $OUT "$customLib\n" if ( $customLib ne "" );
printf $OUT "$dbversion\n";
close $OUT;
}
elsif ( $options{'mus'} ) {
my $OUT;
open( $OUT, ">$file.tbl" )
|| die "can't create $file.tbl\n";
printf $OUT "==================================================\n";
printf $OUT "file name: %-25s\n", $filename;
printf $OUT "sequences: %7d\n", $seq_cnt;
printf $OUT "total length: %10d bp %-25s\n", $totalSeqLen, $nonNSeqLen;
printf $OUT "GC level: %6s \%\n", $frac_GC;
printf $OUT "bases masked: %10d bp ( %4.2f \%)\n", $maskedlength,
$maskedpercent;
printf $OUT "==================================================\n";
printf $OUT " number of length percentage\n";
printf $OUT " elements* occupied of sequence\n";
printf $OUT "--------------------------------------------------\n";
printf $OUT "SINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SINE'}->{'count'}, $aggregateStats{'SINE'}->{'length'},
$aggregateStats{'SINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Alu/B1 %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/Alu"}, $totlength{"SINE/Alu"},
$totlength{"SINE/Alu"} * 100 * $usePerc / $totseqlen;
printf $OUT " B2-B4 %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/B2"} + $uniqCount{"SINE/B4"},
$totlength{"SINE/B2"} + $totlength{"SINE/B4"},
( $totlength{"SINE/B2"} + $totlength{"SINE/B4"} ) * 100 * $usePerc /
$totseqlen;
printf $OUT " IDs %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/ID"}, $totlength{"SINE/ID"},
$totlength{"SINE/ID"} * 100 * $usePerc / $totseqlen;
printf $OUT " MIRs %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/MIR"}, $totlength{"SINE/MIR"},
$totlength{"SINE/MIR"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINE'}->{'count'}, $aggregateStats{'LINE'}->{'length'},
$aggregateStats{'LINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L1"}, $totlength{"LINE/L1"},
$totlength{"LINE/L1"} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE2 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L2"}, $totlength{"LINE/L2"},
$totlength{"LINE/L2"} * 100 * $usePerc / $totseqlen;
printf $OUT " L3/CR1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/CR1"}, $totlength{"LINE/CR1"},
$totlength{"LINE/CR1"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LTR elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTR'}->{'count'}, $aggregateStats{'LTR'}->{'length'},
$aggregateStats{'LTR'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL"}, $totlength{"LTR/ERVL"},
$totlength{"LTR/ERVL"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL-MaLRs %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL-MaLR"}, $totlength{"LTR/ERVL-MaLR"},
$totlength{"LTR/ERVL-MaLR"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classI %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERV1"}, $totlength{"LTR/ERV1"},
$totlength{"LTR/ERV1"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classII %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVK"}, $totlength{"LTR/ERVK"},
$totlength{"LTR/ERVK"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "DNA elements: %6d %10dbp %5.2f \%\n",
$aggregateStats{'DNA'}->{'count'}, $aggregateStats{'DNA'}->{'length'},
$aggregateStats{'DNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " hAT-Charlie %6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/hAT-Charlie"}, $totlength{"DNA/hAT-Charlie"},
$totlength{"DNA/hAT-Charlie"} * 100 * $usePerc / $totseqlen;
printf $OUT " TcMar-Tigger%6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/TcMar-Tigger"}, $totlength{"DNA/TcMar-Tigger"},
$totlength{"DNA/TcMar-Tigger"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Unclassified: %6d %10d bp %5.2f \%\n",
$aggregateStats{'OTHER'}->{'count'},
$aggregateStats{'OTHER'}->{'length'},
$aggregateStats{'OTHER'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Total interspersed repeats:%10d bp %5.2f \%\n", $totallength,
$totallength * 100 * $usePerc / $totseqlen;
printf $OUT "\n\n";
printf $OUT "Small RNA: %6d %10d bp %5.2f \%\n",
$aggregateStats{'RNA'}->{'count'}, $aggregateStats{'RNA'}->{'length'},
$aggregateStats{'RNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Satellites: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SATEL'}->{'count'},
$aggregateStats{'SATEL'}->{'length'},
$aggregateStats{'SATEL'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Simple repeats: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SIMPLE'}->{'count'},
$aggregateStats{'SIMPLE'}->{'length'},
$aggregateStats{'SIMPLE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Low complexity: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LOWCOMP'}->{'count'},
$aggregateStats{'LOWCOMP'}->{'length'},
$aggregateStats{'LOWCOMP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "==================================================\n";
printf $OUT "\n";
printf $OUT "* most repeats fragmented by insertions or deletions\n";
printf $OUT " have been counted as one element\n";
printf $OUT "%54s\n", $exclnote;
printf $OUT "\n";
printf $OUT "The query species was assumed to be %-14s\n",
$options{'species'};
printf $OUT "%-82s\n", substr( $versionmode, 0, 82 );
printf $OUT "$engine\n";
printf $OUT "$customLib\n" if ( $customLib ne "" );
printf $OUT "$dbversion\n";
close $OUT;
}
elsif ( $options{'mammal'} ) {
my $OUT;
open( $OUT, ">$file.tbl" )
|| die "can't create $file.tbl\n";
printf $OUT "==================================================\n";
printf $OUT "file name: %-25s\n", $filename;
printf $OUT "sequences: %7d\n", $seq_cnt;
printf $OUT "total length: %10d bp %-25s\n", $totalSeqLen, $nonNSeqLen;
printf $OUT "GC level: %6s \%\n", $frac_GC;
printf $OUT "bases masked: %10d bp ( %4.2f \%)\n", $maskedlength,
$maskedpercent;
printf $OUT "==================================================\n";
printf $OUT " number of length percentage\n";
printf $OUT " elements* occupied of sequence\n";
printf $OUT "--------------------------------------------------\n";
printf $OUT "SINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SINE'}->{'count'}, $aggregateStats{'SINE'}->{'length'},
$aggregateStats{'SINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Alu/B1 %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/Alu"}, $totlength{"SINE/Alu"},
$totlength{"SINE/Alu"} * 100 * $usePerc / $totseqlen;
printf $OUT " MIRs %6d %10d bp %5.2f \%\n",
$uniqCount{"SINE/MIR"}, $totlength{"SINE/MIR"},
$totlength{"SINE/MIR"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINE'}->{'count'}, $aggregateStats{'LINE'}->{'length'},
$aggregateStats{'LINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L1"}, $totlength{"LINE/L1"},
$totlength{"LINE/L1"} * 100 * $usePerc / $totseqlen;
printf $OUT " LINE2 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L2"}, $totlength{"LINE/L2"},
$totlength{"LINE/L2"} * 100 * $usePerc / $totseqlen;
printf $OUT " L3/CR1 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/CR1"}, $totlength{"LINE/CR1"},
$totlength{"LINE/CR1"} * 100 * $usePerc / $totseqlen;
printf $OUT " RTE %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINERTE'}->{'count'},
$aggregateStats{'LINERTE'}->{'length'},
$aggregateStats{'LINERTE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "LTR elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTR'}->{'count'}, $aggregateStats{'LTR'}->{'length'},
$aggregateStats{'LTR'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL"}, $totlength{"LTR/ERVL"},
$totlength{"LTR/ERVL"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERVL-MaLRs %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVL-MaLR"}, $totlength{"LTR/ERVL-MaLR"},
$totlength{"LTR/ERVL-MaLR"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classI %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERV1"}, $totlength{"LTR/ERV1"},
$totlength{"LTR/ERV1"} * 100 * $usePerc / $totseqlen;
printf $OUT " ERV_classII %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/ERVK"}, $totlength{"LTR/ERVK"},
$totlength{"LTR/ERVK"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "DNA elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNA'}->{'count'}, $aggregateStats{'DNA'}->{'length'},
$aggregateStats{'DNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " hAT-Charlie %6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/hAT-Charlie"}, $totlength{"DNA/hAT-Charlie"},
$totlength{"DNA/hAT-Charlie"} * 100 * $usePerc / $totseqlen;
printf $OUT " TcMar-Tigger%6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/TcMar-Tigger"}, $totlength{"DNA/TcMar-Tigger"},
$totlength{"DNA/TcMar-Tigger"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Unclassified: %6d %10d bp %5.2f \%\n",
$aggregateStats{'OTHER'}->{'count'},
$aggregateStats{'OTHER'}->{'length'},
$aggregateStats{'OTHER'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Total interspersed repeats:%10d bp %5.2f \%\n", $totallength,
$totallength * 100 * $usePerc / $totseqlen;
printf $OUT "\n\n";
printf $OUT "Small RNA: %6d %10d bp %5.2f \%\n",
$aggregateStats{'RNA'}->{'count'}, $aggregateStats{'RNA'}->{'length'},
$aggregateStats{'RNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Satellites: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SATEL'}->{'count'},
$aggregateStats{'SATEL'}->{'length'},
$aggregateStats{'SATEL'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Simple repeats: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SIMPLE'}->{'count'},
$aggregateStats{'SIMPLE'}->{'length'},
$aggregateStats{'SIMPLE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Low complexity: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LOWCOMP'}->{'count'},
$aggregateStats{'LOWCOMP'}->{'length'},
$aggregateStats{'LOWCOMP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "==================================================\n";
printf $OUT "\n";
printf $OUT "* most repeats fragmented by insertions or deletions\n";
printf $OUT " have been counted as one element\n";
printf $OUT "%54s\n", $exclnote;
printf $OUT "\n";
printf $OUT "The query species was assumed to be %-14s\n",
$options{'species'};
printf $OUT "%-82s\n", substr( $versionmode, 0, 82 );
printf $OUT "$engine\n";
printf $OUT "$customLib\n" if ( $customLib ne "" );
printf $OUT "$dbversion\n";
close $OUT;
}
else {
my $OUT;
open( $OUT, ">$file.tbl" ) || die "can't create $file.tbl\n";
printf $OUT "==================================================\n";
printf $OUT "file name: %-25s\n", $filename;
printf $OUT "sequences: %7d\n", $seq_cnt;
printf $OUT "total length: %10d bp %-25s\n", $totalSeqLen, $nonNSeqLen;
printf $OUT "GC level: %6s \%\n", $frac_GC;
printf $OUT "bases masked: %10d bp ( %4.2f \%)\n", $maskedlength,
$maskedpercent;
printf $OUT "==================================================\n";
printf $OUT " number of length percentage\n";
printf $OUT " elements* occupied of sequence\n";
printf $OUT "--------------------------------------------------\n";
printf $OUT "Retroelements %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINE'}->{'count'} +
$aggregateStats{'SINE'}->{'count'} + $aggregateStats{'LTR'}->{'count'},
$aggregateStats{'LINE'}->{'length'} +
$aggregateStats{'SINE'}->{'length'} +
$aggregateStats{'LTR'}->{'length'},
( $aggregateStats{'LINE'}->{'length'} +
$aggregateStats{'SINE'}->{'length'} +
$aggregateStats{'LTR'}->{'length'} ) * 100 * $usePerc / $totseqlen;
printf $OUT " SINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SINE'}->{'count'}, $aggregateStats{'SINE'}->{'length'},
$aggregateStats{'SINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Penelope %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/Penelope"}, $totlength{"LINE/Penelope"},
$totlength{"LINE/Penelope"} * 100 * $usePerc / $totseqlen;
printf $OUT " LINEs: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINE'}->{'count'}, $aggregateStats{'LINE'}->{'length'},
$aggregateStats{'LINE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " CRE/SLACS %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/CRE"}, $totlength{"LINE/CRE"},
$totlength{"LINE/CRE"} * 100 * $usePerc / $totseqlen;
printf $OUT " L2/CR1/Rex %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINECR1'}->{'count'},
$aggregateStats{'LINECR1'}->{'length'},
$aggregateStats{'LINECR1'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " R1/LOA/Jockey %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINEI'}->{'count'},
$aggregateStats{'LINEI'}->{'length'},
$aggregateStats{'LINEI'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " R2/R4/NeSL %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINER2'}->{'count'},
$aggregateStats{'LINER2'}->{'length'},
$aggregateStats{'LINER2'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " RTE/Bov-B %6d %10d bp %5.2f \%\n",
$aggregateStats{'LINERTE'}->{'count'},
$aggregateStats{'LINERTE'}->{'length'},
$aggregateStats{'LINERTE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " L1/CIN4 %6d %10d bp %5.2f \%\n",
$uniqCount{"LINE/L1"}, $totlength{"LINE/L1"},
$totlength{"LINE/L1"} * 100 * $usePerc / $totseqlen;
printf $OUT " LTR elements: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTR'}->{'count'}, $aggregateStats{'LTR'}->{'length'},
$aggregateStats{'LTR'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " BEL/Pao %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTRBEL'}->{'count'},
$aggregateStats{'LTRBEL'}->{'length'},
$aggregateStats{'LTRBEL'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Ty1/Copia %6d %10d bp %5.2f \%\n",
$uniqCount{"LTR/Copia"}, $totlength{"LTR/Copia"},
$totlength{"LTR/Copia"} * 100 * $usePerc / $totseqlen;
printf $OUT " Gypsy/DIRS1 %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTRGYP'}->{'count'},
$aggregateStats{'LTRGYP'}->{'length'},
$aggregateStats{'LTRGYP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Retroviral %6d %10d bp %5.2f \%\n",
$aggregateStats{'LTRERV'}->{'count'},
$aggregateStats{'LTRERV'}->{'length'},
$aggregateStats{'LTRERV'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "DNA transposons %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNA'}->{'count'}, $aggregateStats{'DNA'}->{'length'},
$aggregateStats{'DNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " hobo-Activator %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNAHAT'}->{'count'},
$aggregateStats{'DNAHAT'}->{'length'},
$aggregateStats{'DNAHAT'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Tc1-IS630-Pogo %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNATC1'}->{'count'},
$aggregateStats{'DNATC1'}->{'length'},
$aggregateStats{'DNATC1'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " En-Spm %6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/En-Spm"}, $totlength{"DNA/En-Spm"},
$totlength{"DNA/En-Spm"} * 100 * $usePerc / $totseqlen;
printf $OUT " MuDR-IS905 %6d %10d bp %5.2f \%\n",
$uniqCount{"DNA/MuDR"}, $totlength{"DNA/MuDR"},
$totlength{"DNA/MuDR"} * 100 * $usePerc / $totseqlen;
printf $OUT " PiggyBac %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNAPIG'}->{'count'},
$aggregateStats{'DNAPIG'}->{'length'},
$aggregateStats{'DNAPIG'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Tourist/Harbinger%6d %10d bp %5.2f \%\n",
$aggregateStats{'DNAH'}->{'count'}, $aggregateStats{'DNAH'}->{'length'},
$aggregateStats{'DNAH'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " Other (Mirage, %6d %10d bp %5.2f \%\n",
$aggregateStats{'DNAP'}->{'count'}, $aggregateStats{'DNAP'}->{'length'},
$aggregateStats{'DNAP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT " P-element, Transib)\n";
printf $OUT "\n";
printf $OUT "Rolling-circles %6d %10d bp %5.2f \%\n",
$uniqCount{"RC/Helicop"}, $totlength{"RC/Helicop"},
$totlength{"RC/Helicop"} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Unclassified: %6d %10d bp %5.2f \%\n",
$aggregateStats{'OTHER'}->{'count'},
$aggregateStats{'OTHER'}->{'length'},
$aggregateStats{'OTHER'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Total interspersed repeats: %10d bp %5.2f \%\n",
$totallength, $totallength * 100 * $usePerc / $totseqlen;
printf $OUT "\n\n";
printf $OUT "Small RNA: %6d %10d bp %5.2f \%\n",
$aggregateStats{'RNA'}->{'count'}, $aggregateStats{'RNA'}->{'length'},
$aggregateStats{'RNA'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "\n";
printf $OUT "Satellites: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SATEL'}->{'count'},
$aggregateStats{'SATEL'}->{'length'},
$aggregateStats{'SATEL'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Simple repeats: %6d %10d bp %5.2f \%\n",
$aggregateStats{'SIMPLE'}->{'count'},
$aggregateStats{'SIMPLE'}->{'length'},
$aggregateStats{'SIMPLE'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "Low complexity: %6d %10d bp %5.2f \%\n",
$aggregateStats{'LOWCOMP'}->{'count'},
$aggregateStats{'LOWCOMP'}->{'length'},
$aggregateStats{'LOWCOMP'}->{'length'} * 100 * $usePerc / $totseqlen;
printf $OUT "==================================================\n";
printf $OUT "\n";
printf $OUT "* most repeats fragmented by insertions or deletions\n";
printf $OUT " have been counted as one element\n";
printf $OUT "%54s\n", $exclnote;
printf $OUT "\n";
printf $OUT "The query species was assumed to be %-14s\n",
$options{'species'};
printf $OUT "%-82s\n", substr( $versionmode, 0, 82 );
printf $OUT "$engine\n";
printf $OUT "$customLib\n" if ( $customLib ne "" );
printf $OUT "$dbversion\n";
close $OUT;
}
} # sub generateOutput();
##-------------------------------------------------------------------------##
## Use: my ( $chainBegRef, $chainEndRef ) =
## &cycleReJoin( $sortedAnnotationsList );
##
## $sortedAnnotationsList : Annotations to be processed
##
## Join fragments broken up by RepeatMasker's clipping strategy.
## The signature ( currently ) for these fragments is:
##
## +-----+ +-------+
## | | | |
## ------ ------- --------
## F1 F2 F3
##
## SW PctSub PctDel PctIns
## F1 = 100 10% 3% 2%
## F2 = 100 10% 3% 2%
## F3 = 323 15% 2% 7%
##
## Fragments which come from the same alignment will have
## the same Score, PctSub, PctDel, and PctIns. Other fragments
## may be linked but do not come from the same original alignment.
##
## Returns
## Two references to hashes. The hashes store the seq2beg/end for
## each ID ie. $chainBegRef->{ID} = #. These data structures are
## currently used in cycles 2 & 3.
##
## Also now sets setRMAlignQueryLen() for each hit. The returned
## hashes should be also be made into Hit properties.
##
##-------------------------------------------------------------------------##
sub cycleReJoin {
my $sortedAnnotationsList = shift;
$sortedAnnotationsList->sort( \&bySeqSWConbegin );
my $cycleAnnotIter = $sortedAnnotationsList->getIterator();
my %chainSeq2Beg = ();
my %chainSeq2End = ();
my $i = -1;
while ( $cycleAnnotIter->hasNext() ) {
$i++;
$DEBUG = 0;
print STDERR "." if ( $i + 1 ) % 1000 == 0;
my $currentAnnot = $cycleAnnotIter->next();
next
if (
(
$currentAnnot->getLeftLinkedHit()
&& $currentAnnot->getLeftLinkedHit() != $currentAnnot
)
|| ( $currentAnnot->getRightLinkedHit()
&& $currentAnnot->getRightLinkedHit() != $currentAnnot )
);
# Simple and Low Complexity repeats should not be rejoined.
# There are often large gaps and misalignments which do not
# necessary indicate that the fragments should be part of
# one alignment. I.e consider two alus side by side with
# long poly-A tails. In some cases the poly-A tails will be
# joined as one alignment when in fact they are two independent
# regions.
next if ( $currentAnnot->getClassName() =~ /Simple|Low_/ );
#
# Join fragments artificially broken up by repeatmasker
#
# Rules: Same HitName
# Same Sequence
# Same Score, divg's
# Cons Boundaries match
my $proxIter = $cycleAnnotIter->getIterator();
my @compatIDs = ( $currentAnnot );
my $lastSeq2Begin = $currentAnnot->getSeq2Beg();
my $lastSeq2End = $currentAnnot->getSeq2End();
my $combinedSeq1Length =
$currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() + 1;
my $lowestSeq2Pos = $lastSeq2Begin;
my $lastAnnot = $currentAnnot;
$lowestSeq2Pos = $lastSeq2End
if ( $lowestSeq2Pos > $lastSeq2End );
my $highestSeq2Pos = $lastSeq2Begin;
$highestSeq2Pos = $lastSeq2End
if ( $highestSeq2Pos < $lastSeq2End );
my $contained = 0;
while ( $proxIter->hasNext() ) {
my $nextAnnot = $proxIter->next();
if ( $nextAnnot->containsElement( $currentAnnot ) ) {
$contained = 1;
}
last
unless ( $currentAnnot->getSeq1Name() eq $nextAnnot->getSeq1Name()
&& $nextAnnot->getSW() == $currentAnnot->getSW() );
my $nextHitName = $nextAnnot->getHitName();
my $nextClassName = $nextAnnot->getClassName();
# Note: Currently annotations in RepeatMasker may skip reporting
# segments of alignments between clipped out markers "x"s which are
# smaller than 5 bp long. I upped the tolerance here to handle
# these separated fragments.
if (
$nextHitName eq $currentAnnot->getHitName()
&& !$nextAnnot->getLeftLinkedHit()
&& !$nextAnnot->getRightLinkedHit()
&& $nextAnnot->getLastField() == $currentAnnot->getLastField()
&& $nextAnnot->getPctSubst() == $currentAnnot->getPctSubst()
&& $nextAnnot->getPctInsert() == $currentAnnot->getPctInsert()
&& $nextAnnot->getPctDelete() == $currentAnnot->getPctDelete()
&& (
abs( $nextAnnot->getSeq2Beg() - $lastSeq2End ) < 5
||
# I don't think I need this or
abs( $nextAnnot->getSeq2End() - $lastSeq2Begin ) < 5
)
)
{
if ( $DEBUG ) {
print STDERR "Joining RepeatMasker fragmented alignment:\n";
$currentAnnot->print();
print STDERR " because of next:\n";
$nextAnnot->print();
}
if ( $contained && $DEBUG ) {
print STDERR "\n\n\n\n\n\nWARNING WARNING -- containment "
. "breached!\n\n\n\n\n\n";
}
$lastAnnot->join( $nextAnnot );
if ( $DEBUG ) {
if ( $currentAnnot->getHitName() eq "AluSx"
&& $currentAnnot->getRevComp eq "C" )
{
print STDERR "Special!\n";
print STDERR "nexts right partner:\n";
$nextAnnot->getRightLinkedHit()->print();
print STDERR "currents left partner:\n";
$currentAnnot->getLeftLinkedHit()->print();
}
}
push @compatIDs, $nextAnnot;
$lastAnnot = $nextAnnot;
$combinedSeq1Length +=
$nextAnnot->getSeq1End() - $nextAnnot->getSeq1Beg() + 1;
$lastSeq2Begin = $nextAnnot->getSeq2Beg();
$lastSeq2End = $nextAnnot->getSeq2End();
$lowestSeq2Pos = $nextAnnot->getSeq2Beg()
if ( $lowestSeq2Pos > $nextAnnot->getSeq2Beg() );
$lowestSeq2Pos = $nextAnnot->getSeq2End()
if ( $lowestSeq2Pos > $nextAnnot->getSeq2End() );
$highestSeq2Pos = $nextAnnot->getSeq2Beg()
if ( $highestSeq2Pos < $nextAnnot->getSeq2Beg() );
$highestSeq2Pos = $nextAnnot->getSeq2End()
if ( $highestSeq2Pos < $nextAnnot->getSeq2End() );
}
}
if ( @compatIDs > 1 ) {
if ( $DEBUG ) {
print STDERR "Chain range = $lowestSeq2Pos - $highestSeq2Pos\n";
}
foreach my $annot ( @compatIDs ) {
print STDERR " Setting: chainSeq2Beg/End{ " . $annot->getID() . " }\n"
if ( $DEBUG );
$chainSeq2Beg{ $annot->getID() } = $lowestSeq2Pos;
$chainSeq2End{ $annot->getID() } = $highestSeq2Pos;
$annot->setRMAlignQueryLen( $combinedSeq1Length );
}
}
else {
my $singleAnnot = shift @compatIDs;
if ( $DEBUG ) {
print STDERR "Adding singleton = "
. ( $currentAnnot->getSeq2Beg() - $currentAnnot->getSeq2End() )
. "ID="
. $currentAnnot->getID() . "\n";
$currentAnnot->print();
}
$chainSeq2Beg{ $singleAnnot->getID() } = $currentAnnot->getSeq2Beg();
$chainSeq2End{ $singleAnnot->getID() } = $currentAnnot->getSeq2End();
$singleAnnot->setRMAlignQueryLen(
$currentAnnot->getSeq1End() - $currentAnnot->getSeq1Beg() + 1 );
}
}
return ( \%chainSeq2Beg, \%chainSeq2End );
}
sub printAlignAnnots {
my $fileName = shift;
my $id = shift;
my $seq1lengths = shift;
my %colWidths = %{ shift() };
my $annots = shift;
my $ALIGNOUT = new FileHandle;
open $ALIGNOUT, ">$fileName" || die "Cannot open $fileName: $!\n";
#
# Print the align file.
#
my $cycleAnnotIter = $annots->getIterator();
my $pastAnnot = undef;
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
# Get the next annot
my $nextAnnot = undef;
if ( $cycleAnnotIter->hasNext ) {
$nextAnnot = $cycleAnnotIter->next();
$cycleAnnotIter->previous();
}
#
# Indicate overlapping sequences in table
#
my $Overlapped = "";
if (
(
$pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name
&& $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSW < $pastAnnot->getSW
&& $currentAnnot->getLastField eq $pastAnnot->getLastField
)
|| ( $nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End >= $nextAnnot->getSeq1Beg()
&& $currentAnnot->getSW < $nextAnnot->getSW()
&& $currentAnnot->getLastField eq $nextAnnot->getLastField() )
)
{
$Overlapped = "*";
}
# format fields
my $LeftOver =
$seq1lengths->{ $currentAnnot->getSeq1Name } -
$currentAnnot->getSeq1End;
my $LeftOverPrint = "(" . $LeftOver . ")";
my $Seq2BeginPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
my $LeftUnalignedPrint = $currentAnnot->getSeq2Beg();
if ( $currentAnnot->getRevComp eq '+' ) {
$Seq2BeginPrint = $currentAnnot->getSeq2Beg();
$LeftUnalignedPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
}
my $printid = $id->{ $currentAnnot->getID() };
my $PctSubst = sprintf "%4.1f", $currentAnnot->getPctSubst;
my $PctDelete = sprintf "%4.1f", $currentAnnot->getPctDelete;
my $PctInsert = sprintf "%4.1f", $currentAnnot->getPctInsert;
if ( $options{'lcambig'} ) {
# Use repeat name case to highlight ambiguous DNA
# transposon fragments
$currentAnnot->setHitName( uc( $currentAnnot->getHitName() ) );
$currentAnnot->setHitName( lc( $currentAnnot->getHitName() ) )
if ( $currentAnnot->getEquivHash()
&& $currentAnnot->getClassName() =~ /DNA/ );
}
if ( 0 ) {
print $ALIGNOUT " ";
printf $ALIGNOUT "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. $currentAnnot->getHitName()
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s ", $currentAnnot->getSW(),
$PctSubst, $PctDelete, $PctInsert, $currentAnnot->getSeq1Name(),
$currentAnnot->getSeq1Beg(), $currentAnnot->getSeq1End(),
$LeftOverPrint, $currentAnnot->getRevComp(),
$currentAnnot->getHitName(), $currentAnnot->getClassName(),
$Seq2BeginPrint, $currentAnnot->getSeq2End(), $LeftUnalignedPrint;
printf $ALIGNOUT "%${colWidths{'ID'}}s %1s\n", $printid, $Overlapped;
}
if ( defined $currentAnnot->getDerivedFromAnnot() ) {
#print $ALIGNOUT "ANNOTATION EVIDENCE:\n";
#&printSourceAlignments( $ALIGNOUT, $currentAnnot, \%colWidths, 0, " " );
&printSourceAlignments( $ALIGNOUT, $currentAnnot, \%colWidths, 0,
$printid );
}
print $ALIGNOUT "\n";
$pastAnnot = $currentAnnot;
} # while loop
close $ALIGNOUT;
} # sub printAlignAnnots
sub printHTMLAnnots {
my $fileName = shift;
my $id = shift;
my $seq1lengths = shift;
my %colWidths = %{ shift() };
my $annots = shift;
my $HTMLOUT = new FileHandle;
my $hdrTmplFile = "$FindBin::RealBin/HTMLAnnotHeader.html";
open $HTMLOUT, ">$fileName" || die "Cannot open $fileName\n";
open HDR, "<$hdrTmplFile"
|| die "printHTMLAnnots(): Cannot open header template $hdrTmplFile\n";
while ( <HDR> ) {
print $HTMLOUT $_;
}
close HDR;
my $widthposquery = $colWidths{'BeginAlign'} + $colWidths{'EndAlign'} +
$colWidths{'LeftOver'} + 2;
my $widthposrepeat = $colWidths{'Seq2Begin'} + $colWidths{'Seq2End'} +
$colWidths{'LeftUnaligned'} + 2;
print $HTMLOUT "<div id=\"repeatTable\" style=\"padding-right: 30px;\">\n";
print $HTMLOUT
"<div class=\"header\" id=\"colHeaderContainer\" style=\"background-color: #bcc3c8; border-bottom: 2px solid; margin-bottom: 5px;\">\n";
print $HTMLOUT "<pre><b id=\"colHeaderText\">\n";
# TODO:
# Calculate nesting depth and include as parameter to CSS/Javascript
#
# Print Header
#
# The header ( and all annotations lines for that matter ) are printed
# as preformatted ( <pre> ) text in the HTML file. It is important
# that the correct number of spaces are used between column headings
# in order to match the data.
#
# First line of header
my $hdrLine =
" " x (
9 + $colWidths{'SW'} + $colWidths{'PctSubst'} + $colWidths{'PctDelete'} +
$colWidths{'PctInsert'} + $colWidths{'Seq1Name'} )
. &fmtField(
2 + $colWidths{'BeginAlign'} + $colWidths{'EndAlign'} +
$colWidths{'LeftOver'},
'position in query',
"C",
"-"
)
. " " x ( 5 + $colWidths{'HitName'} + $colWidths{'class'} )
. &fmtField(
2 + $colWidths{'Seq2Begin'} + $colWidths{'Seq2End'} +
$colWidths{'LeftUnaligned'},
'position in repeat', "C", "-"
)
. "\n";
print $HTMLOUT $hdrLine;
# Second line of header
$hdrLine =
" " x ( 3 + $colWidths{'SW'} )
. '<span title="Percent divergence.">'
. &fmtField( $colWidths{'PctSubst'}, "%", "C" )
. "</span>" . " "
. '<span title="Percent deletion.">'
. &fmtField( $colWidths{'PctDelete'}, "%", "C" )
. "</span>" . " "
. '<span title="Percent insertion.">'
. &fmtField( $colWidths{'PctInsert'}, "%", "C" )
. "</span>" . " "
. '<span title="Query sequence name/id.">'
. &fmtField( $colWidths{'Seq1Name'}, "query", "L" )
. "</span>"
. " " x ( 5 + $colWidths{'BeginAlign'} + $colWidths{'EndAlign'} +
$colWidths{'LeftOver'} )
. '<span title="Orientation of the repeat c=minus +=plus.">' . "C"
. "</span>" . " "
. '<span title="Name/ID of repeat.">'
. &fmtField( $colWidths{'HitName'}, "matching", "L" )
. "</span>" . " "
. '<span title="Repeat class and family.">'
. &fmtField( $colWidths{'class'}, "repeat", "L" )
. "</span>" . " "
. '<span title="Start position or remaining bases in repeat consensus.">'
. &fmtField( $colWidths{'Seq2Begin'}, "(left)", "C" )
. "</span>" . " "
. '<span title="End position in repeat consensus.">'
. &fmtField( $colWidths{'Seq2End'}, "end", "C" )
. "</span>" . " "
. '<span title="Start position or remaining bases in repeat consensus.">'
. &fmtField( $colWidths{'LeftUnaligned'}, "begin", "C" )
. "</span>" . " "
. '<span title="Linked repeats are denoted with duplicate IDs and connecting graphic bars.">'
. "linkage"
. "</span>\n";
print $HTMLOUT $hdrLine;
# Third line of header
$hdrLine =
'<span title="Click on this link to expand/collapse individual annotation details.">'
. "<u>+</u>"
. "</span>" . " "
. '<span title="Complexity adjusted Smith Waterman score.">'
. &fmtField( $colWidths{'SW'}, "score", "L" )
. "</span>" . " "
. '<span title="Percent divergence.">'
. &fmtField( $colWidths{'PctSubst'}, "div.", "R" )
. "</span>" . " "
. '<span title="Percent deletion.">'
. &fmtField( $colWidths{'PctDelete'}, "del.", "R" )
. "</span>" . " "
. '<span title="Percent insertion.">'
. &fmtField( $colWidths{'PctInsert'}, "ins.", "R" )
. "</span>" . " "
. '<span title="Query sequence name/id.">'
. &fmtField( $colWidths{'Seq1Name'}, "sequence", "L" )
. "</span>" . " "
. '<span title="Start of annotation in sequence. The first base is numbered 1.">'
. &fmtField( $colWidths{'BeginAlign'}, "begin", "C" )
. "</span>" . " "
. '<span title="End of annotation in sequence. The first base is numbered 1.">'
. &fmtField( $colWidths{'EndAlign'}, "end", "C" )
. "</span>" . " "
. '<span title="The number of bases remaining in sequence.">'
. &fmtField( $colWidths{'LeftOver'}, "(left)", "C" )
. "</span>" . " "
. '<span title="Orientation of the repeat c=minus +=plus.">' . "+"
. "</span>" . " "
. '<span title="Name/ID of repeat.">'
. &fmtField( $colWidths{'HitName'}, "repeat", "L" )
. "</span>" . " "
. '<span title="Repeat class and family.">'
. &fmtField( $colWidths{'class'}, "class/family", "L" )
. "</span>" . " "
. '<span title="Start position or remaining bases in repeat consensus.">'
. &fmtField( $colWidths{'Seq2Begin'}, "begin", "C" )
. "</span>" . " "
. '<span title="End position in repeat consensus.">'
. &fmtField( $colWidths{'Seq2End'}, "end", "C" )
. "</span>" . " "
. '<span title="Start position or remaining bases in repeat consensus.">'
. &fmtField( $colWidths{'LeftUnaligned'}, "(left)", "C" )
. "</span>" . " "
. '<span title="Linked repeats are denoted with duplicate IDs and connecting graphic bars.">'
. "id/graphic"
. "</span></b>\n";
print $HTMLOUT $hdrLine;
# First line of header
#printf $HTMLOUT " %${colWidths{'SW'}}s %${colWidths{'PctSubst'}}s "
# . "%${colWidths{'PctDelete'}}s "
# . "%${colWidths{'PctInsert'}}s "
# . "%-${colWidths{'Seq1Name'}}s "
# . "%-${widthposquery}s "
# . "%-${colWidths{'HitName'}}s %-${colWidths{'class'}}s "
# . "%${widthposrepeat}s %s\n", 'SW', 'perc', 'perc', 'perc', 'query',
# position in query', 'matching', 'repeat', 'position in repeat',
# ' linkage';
# Second line of header
#printf $HTMLOUT " %${colWidths{'SW'}}s %${colWidths{'PctSubst'}}s "
# . "%${colWidths{'PctDelete'}}s "
# . "%${colWidths{'PctInsert'}}s "
# . "%-${colWidths{'Seq1Name'}}s "
# . "%-${colWidths{'BeginAlign'}}s "
# . "%-${colWidths{'EndAlign'}}s "
# . "%${colWidths{'LeftOver'}}s "
# . "%-${colWidths{'HitName'}}s "
# . "%-${colWidths{'class'}}s "
# . "%-${colWidths{'Seq2Begin'}}s "
# . "%-${colWidths{'Seq2End'}}s "
# . "%-${colWidths{'LeftUnaligned'}}s %${colWidths{'ID'}}s</b>", 'score', 'div.', 'del.',
# 'ins.', 'sequence', 'begin', 'end', '(left)', 'repeat',
# 'class/family', 'begin', 'end', '(left)', 'id / graphic';
print $HTMLOUT "</pre>\n";
print $HTMLOUT "</div>\n";
#
# Print the out file.
#
my $cycleAnnotIter = $annots->getIterator();
my $pastAnnot = undef;
my $blueDivToggle = 0;
my $hspsID = 1;
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
# Get the next annot
my $nextAnnot = undef;
if ( $cycleAnnotIter->hasNext ) {
$nextAnnot = $cycleAnnotIter->next();
$cycleAnnotIter->previous();
# NOTE: If you are going to remove anything in this
# cycle you should move back and forward so
# the last thing returned is the previous one.
}
#
# Indicate overlapping sequences in table
#
my $Overlapped = "";
if (
(
$pastAnnot
&& $currentAnnot->getSeq1Name eq $pastAnnot->getSeq1Name
&& $currentAnnot->getSeq1Beg <= $pastAnnot->getSeq1End
&& $currentAnnot->getSW < $pastAnnot->getSW
&& $currentAnnot->getLastField eq $pastAnnot->getLastField
)
|| ( $nextAnnot
&& $currentAnnot->getSeq1Name eq $nextAnnot->getSeq1Name()
&& $currentAnnot->getSeq1End >= $nextAnnot->getSeq1Beg()
&& $currentAnnot->getSW < $nextAnnot->getSW()
&& $currentAnnot->getLastField eq $nextAnnot->getLastField() )
)
{
$Overlapped = "*";
}
# format fields
my $LeftOver =
$seq1lengths->{ $currentAnnot->getSeq1Name } -
$currentAnnot->getSeq1End;
my $LeftOverPrint = "(" . $LeftOver . ")";
my $Seq2BeginPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
my $LeftUnalignedPrint = $currentAnnot->getSeq2Beg();
if ( $currentAnnot->getRevComp eq '+' ) {
$Seq2BeginPrint = $currentAnnot->getSeq2Beg();
$LeftUnalignedPrint = "(" . $currentAnnot->get3PrimeUnaligned . ")";
}
my $printid = $id->{ $currentAnnot->getID() };
my $PctSubst = sprintf "%4.1f", $currentAnnot->getPctSubst;
my $PctDelete = sprintf "%4.1f", $currentAnnot->getPctDelete;
my $PctInsert = sprintf "%4.1f", $currentAnnot->getPctInsert;
if ( $options{'lcambig'} ) {
# Use repeat name case to highlight ambiguous DNA
# transposon fragments
$currentAnnot->setHitName( uc( $currentAnnot->getHitName() ) );
$currentAnnot->setHitName( lc( $currentAnnot->getHitName() ) )
if ( $currentAnnot->getEquivHash()
&& $currentAnnot->getClassName() =~ /DNA/ );
}
if ( !$currentAnnot->getLeftLinkedHit() ) {
print $HTMLOUT "<div class=\"annotSet\">\n";
}
if ( $blueDivToggle ) {
print $HTMLOUT "<div class=\"bluediv\">";
}
print $HTMLOUT "<pre>";
if ( defined $currentAnnot->getDerivedFromAnnot() ) {
# print link
print $HTMLOUT
"<a href=\"javascript:;\" onmousedown=\"toggleDiv(\'hsps$hspsID\');\">+</a>";
}
else {
print $HTMLOUT " ";
}
print $HTMLOUT "<b>";
printf $HTMLOUT "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "<a class='nound' href='http://www.repeatmasker.org/cgi-bin/ViewRepeat?id="
. $currentAnnot->getHitName() . "'>"
. "%-${colWidths{'HitName'}}s</a> "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s ", $currentAnnot->getSW(), $PctSubst,
$PctDelete, $PctInsert, $currentAnnot->getSeq1Name(),
$currentAnnot->getSeq1Beg(), $currentAnnot->getSeq1End(),
$LeftOverPrint, $currentAnnot->getRevComp(),
$currentAnnot->getHitName(), $currentAnnot->getClassName(),
$Seq2BeginPrint, $currentAnnot->getSeq2End(), $LeftUnalignedPrint;
printf $HTMLOUT "%${colWidths{'ID'}}s %1s", $printid, $Overlapped;
print $HTMLOUT "</b></pre>";
if ( defined $currentAnnot->getDerivedFromAnnot() ) {
print $HTMLOUT
"<div id=\"hsps$hspsID\" style=\"display:none; padding: 10px\">\n";
print $HTMLOUT "<pre>\n";
print $HTMLOUT "<b>ANNOTATION EVIDENCE:</b>\n";
&printSourceAlignments( $HTMLOUT, $currentAnnot, \%colWidths, 1, " " );
print $HTMLOUT "</pre>\n</div>\n";
$hspsID++;
}
if ( $blueDivToggle ) {
print $HTMLOUT "</div>";
}
$blueDivToggle ^= 1;
print $HTMLOUT "\n";
if ( !$currentAnnot->getRightLinkedHit() ) {
print $HTMLOUT "</div>\n";
}
$pastAnnot = $currentAnnot;
} # while loop
close $HTMLOUT;
} # sub printHTMLAnnots
sub fmtField {
my $fldWidth = shift;
my $string = shift;
my $just = shift;
my $pad = shift;
my $retStr = "";
if ( length( $string ) > $fldWidth ) {
# Must truncate
if ( defined $just && $just =~ /C/i ) {
$retStr =
substr( $string, int( ( length( $string ) - $fldWidth ) / 2 ),
$fldWidth );
}
elsif ( defined $just && $just =~ /R/i ) {
$retStr = substr( $string, length( $string ) - $fldWidth, $fldWidth );
}
else {
$retStr = substr( $string, 0, $fldWidth );
}
return $retStr;
}
my $padChar = " ";
if ( defined $pad ) {
$padChar = $pad;
}
# Must pad
if ( defined $just && $just =~ /C/i ) {
my $padPerSide = ( $fldWidth - length( $string ) ) / 2;
if ( int( $padPerSide ) != $padPerSide ) {
$retStr =
$padChar x ( int( $padPerSide ) ) . $string
. $padChar x ( int( $padPerSide ) + 1 );
}
else {
$retStr =
$padChar x ( int( $padPerSide ) ) . $string
. $padChar x ( int( $padPerSide ) );
}
}
elsif ( defined $just && $just =~ /R/i ) {
$retStr = $padChar x ( $fldWidth - length( $string ) ) . $string;
}
else {
$retStr = $string . $padChar x ( $fldWidth - length( $string ) );
}
return $retStr;
}
sub printSourceAlignments {
my $FILE = shift;
my $annot = shift;
my $widthsRef = shift;
my $html = shift;
my $fixedID = shift;
my %colWidths = undef;
%colWidths = %{$widthsRef}
if ( defined $widthsRef );
if ( !defined $annot->getDerivedFromAnnot() ) {
# Allow ID to be overriden.
my $displayID = $annot->getID();
$displayID = $fixedID if ( $fixedID );
# print
if ( defined $widthsRef ) {
if ( $html ) {
printf $FILE "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "<a class='nound' href='http://www.repeatmasker.org/cgi-bin"
. "/ViewRepeat?id="
. $annot->getHitName() . "'>"
. "%-${colWidths{'HitName'}}s</a> "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s %${colWidths{'ID'}}s\n",
$annot->getSW(), $annot->getPctSubst(), $annot->getPctDelete(),
$annot->getPctInsert(), $annot->getSeq1Name(), $annot->getSeq1Beg(),
$annot->getSeq1End(), $annot->getLeftOver(), $annot->getRevComp(),
$annot->getHitName(), $annot->getClassName(), $annot->getSeq2Beg(),
$annot->getSeq2End(), $annot->get3PrimeUnaligned(), $displayID;
}
else {
if ( $annot->getRevComp() eq "C" ) {
printf $FILE "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'LeftUnaligned'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'Seq2Begin'}}s %${colWidths{'ID'}}s\n",
$annot->getSW(), $annot->getPctSubst(), $annot->getPctDelete(),
$annot->getPctInsert(), $annot->getSeq1Name(),
$annot->getSeq1Beg(), $annot->getSeq1End(),
"(" . $annot->getLeftOver() . ")", $annot->getRevComp(),
$annot->getHitName(), $annot->getClassName(),
"(" . $annot->get3PrimeUnaligned() . ")", $annot->getSeq2End(),
$annot->getSeq2Beg(), $displayID;
}
else {
printf $FILE "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s %${colWidths{'ID'}}s\n",
$annot->getSW(), $annot->getPctSubst(), $annot->getPctDelete(),
$annot->getPctInsert(), $annot->getSeq1Name(),
$annot->getSeq1Beg(), $annot->getSeq1End(),
"(" . $annot->getLeftOver() . ")", $annot->getRevComp(),
$annot->getHitName(), $annot->getClassName(),
$annot->getSeq2Beg(), $annot->getSeq2End(),
"(" . $annot->get3PrimeUnaligned() . ")", $displayID;
}
}
}
print $FILE $annot->getAlignData();
}
else {
# recurse
## May need to sort by seq1beg. Look for examples
my @srcMembers = @{ $annot->getDerivedFromAnnot() };
foreach my $member ( @srcMembers ) {
if ( $member == $annot ) {
warn "printSourceAlignments(): Warning - a loop was detected!\n"
. "Please notify the site administrator of this problem.\n";
print $FILE "WARNING: A loop was detected in the evidence reporting\n";
print $FILE "code. Please notify the site administrator of this\n";
print $FILE "problem.\n";
## TODO MUST REMOVE BEFORE NEXT RELEASE -- WEBSERVER ONLY!!
#my $command = "echo \"loop detected in run containing "
# . $annot->getSeq1Name() . "\" >> /tmp/badseeds";
#`$command`;
return;
}
&printSourceAlignments( $FILE, $member, $widthsRef, $html, $fixedID );
}
}
}
sub getMaxColWidths {
my $annotationListRef = shift;
my %widths = (
'SW' => 5,
'PctSubst' => 5,
'PctInsert' => 4,
'PctDelete' => 4,
'Seq1Name' => 8,
'BeginAlign' => 5,
'EndAlign' => 5,
'LeftOver' => 6,
'HitName' => 8,
'class' => 10,
'Seq2Begin' => 6,
'Seq2End' => 6,
'LeftUnaligned' => 6,
'ID' => 3
);
if ( !defined $annotationListRef ) {
return ( %widths );
}
my $annotIter = $annotationListRef->getIterator();
while ( $annotIter->hasNext() ) {
my $annot = $annotIter->next();
my $Seq2BeginLen = length "(" . $annot->get3PrimeUnaligned . ")";
my $LeftUnalignedLen = length $annot->getSeq2Beg();
if ( $annot->getRevComp eq '+' ) {
$Seq2BeginLen = length $annot->getSeq2Beg();
$LeftUnalignedLen = length "(" . $annot->get3PrimeUnaligned . ")";
}
$widths{'SW'} = length $annot->getSW
if $widths{'SW'} < length $annot->getSW;
$widths{'Seq1Name'} = length $annot->getSeq1Name
if $widths{'Seq1Name'} < length $annot->getSeq1Name;
$widths{'BeginAlign'} = length $annot->getSeq1Beg
if $widths{'BeginAlign'} < length $annot->getSeq1Beg;
$widths{'EndAlign'} = length $annot->getSeq1End
if $widths{'EndAlign'} < length $annot->getSeq1End;
$widths{'LeftOver'} = length( $annot->getLeftOver() ) + 2
if $widths{'LeftOver'} < length( $annot->getLeftOver() ) + 2;
$widths{'HitName'} = length $annot->getHitName()
if $widths{'HitName'} < length $annot->getHitName();
$widths{'class'} = length $annot->getClassName
if $widths{'class'} < length $annot->getClassName;
$widths{'Seq2Begin'} = $Seq2BeginLen
if $widths{'Seq2Begin'} < $Seq2BeginLen;
$widths{'Seq2End'} = length $annot->getSeq2End
if $widths{'Seq2End'} < length $annot->getSeq2End;
$widths{'LeftUnaligned'} = $LeftUnalignedLen
if $widths{'LeftUnaligned'} < $LeftUnalignedLen;
$widths{'ID'} = length $annot->getID()
if $widths{'ID'} < length $annot->getID();
}
return ( %widths );
}
sub printSourceAnnots {
my $annot = shift;
my $widthsRef = shift;
my $level = shift;
my %colWidths = %{$widthsRef};
return if ( !defined $annot->getDerivedFromAnnot() );
my @srcMembers = @{ $annot->getDerivedFromAnnot() };
foreach my $member ( @srcMembers ) {
print OUTFULL " " x ( $level ) . "-> ";
printf OUTFULL "%${colWidths{'SW'}}d %${colWidths{'PctSubst'}}s "
. "%${colWidths{'PctDelete'}}s "
. "%${colWidths{'PctInsert'}}s "
. "%-${colWidths{'Seq1Name'}}s "
. "%${colWidths{'BeginAlign'}}s "
. "%${colWidths{'EndAlign'}}s "
. "%${colWidths{'LeftOver'}}s %1s "
. "%-${colWidths{'HitName'}}s "
. "%-${colWidths{'class'}}s "
. "%${colWidths{'Seq2Begin'}}s "
. "%${colWidths{'Seq2End'}}s "
. "%${colWidths{'LeftUnaligned'}}s %${colWidths{'ID'}}s\n",
$member->getSW(), $member->getPctSubst(), $member->getPctDelete(),
$member->getPctInsert(), $member->getSeq1Name(), $member->getSeq1Beg(),
$member->getSeq1End(), $member->getLeftOver(), $member->getRevComp(),
$member->getHitName(), $member->getClassName(), $member->getSeq2Beg(),
$member->getSeq2End(), $member->get3PrimeUnaligned(), $member->getID();
&printSourceAnnots( $member, $widthsRef, $level++ );
}
}
sub scoreLINEPair {
my $annot1 = shift;
my $annot2 = shift;
my $elementDistance = shift;
my $optRef = shift;
my $score = 0;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "scoreLINEPair(): Scoring these two:\n";
$annot1->print();
$annot2->print();
}
# Establish position order
my $leftAnnot = $annot1;
my $rightAnnot = $annot2;
if ( $annot1->comparePositionOrder( $annot2 ) > 0 ) {
$leftAnnot = $annot2;
$rightAnnot = $annot1;
}
# Calculate query overlap
my $queryOverlap = $rightAnnot->getQueryOverlap( $leftAnnot );
# Calculate consensus overlap & consensus gap
my $consensusOverlap = $rightAnnot->getConsensusOverlap( $leftAnnot );
my $consensusGap = -$consensusOverlap;
my $adjConOverlap = $consensusOverlap;
$adjConOverlap -= $queryOverlap if $queryOverlap > 0;
# Determine name compatibility
my $namesCompat = 0;
if ( $leftAnnot->getSeq2Name() eq $rightAnnot->getSeq2Name() ) {
$namesCompat = 1;
}
else {
my $nameHash = undef;
if ( defined $RepeatAnnotationData::lineHash{ $leftAnnot->getHitName() } ) {
$nameHash = $RepeatAnnotationData::lineHash{ $leftAnnot->getHitName() };
}
elsif (
defined $RepeatAnnotationData::lineHash{ $rightAnnot->getHitName() } )
{
#warn "RepeatAnnotationData does not contain data on " .
# $leftAnnot->getHitName() . "\n";
$nameHash = $RepeatAnnotationData::lineHash{ $rightAnnot->getHitName() };
}
else {
#warn "RepeatAnnotationData does not contain data on " .
# $rightAnnot->getHitName() . "\n";
}
if ( $nameHash ) {
my $nameEntry = undef;
if ( defined $nameHash->{ $rightAnnot->getHitName() } ) {
$nameEntry = $nameHash->{ $rightAnnot->getHitName() };
}
elsif ( defined $nameHash->{ $leftAnnot->getHitName() } ) {
#warn "RepeatAnnotationData contains a non-reciprocal entry " .
# $rightAnnot->getHitName() . "\n";
$nameEntry = $nameHash->{ $leftAnnot->getHitName() };
}
if ( $nameEntry ) {
my $overlapThresh = $nameEntry->{'overThresh'};
print STDERR "Names compatible: "
. $rightAnnot->getHitName() . " "
. $leftAnnot->getHitName()
. " ot=$overlapThresh\n"
if ( $DEBUG );
if ( $overlapThresh >= 0 ) {
$namesCompat = 1
if ( $overlapThresh == 0
|| ( $queryOverlap > $overlapThresh ) );
}
} # if ( $nameEntry...
} # if ( $nameHash...
else {
}
} #else names are equal
#
# First use essential qualifiers
# - Same query sequence
# - Same orientation
#
if ( $annot1->getSeq1Name() eq $annot2->getSeq1Name()
&& $annot1->getRevComp() eq $annot2->getRevComp() )
{
print STDERR "scoreLINEPair() get3PrimeUnaligned = "
. $leftAnnot->get3PrimeUnaligned . "\n"
if ( $DEBUG );
#
# Consensus Positions Make Sense
#
# i.e 100-----> 50----->
# or <------200 <------320
#
if (
(
$leftAnnot->getRevComp() eq "+"
&& $rightAnnot->getSeq2Beg() >= $leftAnnot->getSeq2Beg() - 5
|| $leftAnnot->getRevComp() eq "C"
&& $leftAnnot->getSeq2Beg() >= $rightAnnot->getSeq2Beg() - 5
)
)
{
#
# Is the model order valid and is there room
# for model extension?
#
# i.e. do not allow:
# 5 <--- 3
# or 3 ---> 5
#
# Also do not allow ( because? ):
#
# 3 --->| anything
# or anything |<---- 5
#
my $modelCompat = 1;
if (
$leftAnnot->getRevComp() eq "+"
&& $leftAnnot->getSeq2Name() =~ /_3end/
&& ( $rightAnnot->getSeq2Name() =~ /_5end/
|| $leftAnnot->get3PrimeUnaligned() < 10 )
|| $rightAnnot->getRevComp() eq "C"
&& $rightAnnot->getSeq2Name() =~ /_3end/
&& ( $leftAnnot->getSeq2Name() =~ /_5end/
|| $rightAnnot->getLeftOver() < 10 )
)
{
$modelCompat = 0;
}
if ( $modelCompat ) {
if ( $namesCompat ) {
#
# Calculate score:
# - divergence difference ( large = bad )
# - query overlap ( overlap = good, gap = worse )
# - consensus overlap ( large overlap = bad, large gap = bad )
# distfine = CO < 33 && CG <=200 ||
# really complex CO/QO & Div formula
#
# divDiff = The closer the two divergences are to each
# other the closer divDiff gets to its max of
# 1.54. NOTE: It's later limited to 1.2
# wha? wha? wha?
my $divDiff;
if ( $rightAnnot->getPctSubst() > $leftAnnot->getPctSubst()
&& $rightAnnot->getPctSubst() > 0 )
{
$divDiff =
( ( $leftAnnot->getPctSubst() / $rightAnnot->getPctSubst() ) /
0.65 ) -
( ( $rightAnnot->getPctSubst() - $leftAnnot->getPctSubst() ) /
100 );
}
elsif ( $leftAnnot->getPctSubst() > $rightAnnot->getPctSubst()
&& $leftAnnot->getPctSubst() > 0 )
{
$divDiff =
( $rightAnnot->getPctSubst() / $leftAnnot->getPctSubst() ) /
0.65 -
( $leftAnnot->getPctSubst() - $rightAnnot->getPctSubst() ) /
100;
}
else {
$divDiff = 1.2;
}
$divDiff = 1.2 if $divDiff > 1.2;
# Factor decreasing with number of intervening
# elements ( of same type ); should prevent way distant link-ups
my $elementDistanceFactor = 1 - ( $elementDistance - 1 ) / 30;
my $avgLeftUnaligned = $leftAnnot->get3PrimeUnaligned();
$avgLeftUnaligned = $rightAnnot->get3PrimeUnaligned()
if ( $avgLeftUnaligned < $rightAnnot->get3PrimeUnaligned() );
if ( $DEBUG ) {
print STDERR "Stats: queryOverlap = $queryOverlap,\n"
. " consensusOverlap = $consensusOverlap,\n"
. " divDiff = $divDiff > 0.1,\n"
. " elementDistance = $elementDistance,\n"
. " elementDistanceFactor = $elementDistanceFactor,\n"
. " avgLeftUnaligned = $avgLeftUnaligned,\n";
print STDERR " adjConOverlap = $adjConOverlap <= "
. ( ( 3.75 * $avgLeftUnaligned**0.48 - 47 ) *
$elementDistanceFactor**2 * $divDiff )
. ",\n";
print STDERR " consGap = $consensusGap <= "
. (
$elementDistanceFactor * $divDiff * $avgLeftUnaligned / 1.4 )
. "\n";
}
if (
# The allowed conensus overlap is dependent on the position
# in the LINE1 consensus. The further it is from the 3' end
# ($LeftUnaligned) the more overlap is tolerated, this
# somewhat has to do with the relatively poor representation
# of 5' region consensus sequences, but largely because of
# the presence of tandem promoter units. This should be
# solved in a better way, e.g. identifying the tandem
# repeats in the consensus sequences and treating those
# regions as we treat satellites.
# The overlap quadratically relates to the distance in IDs.
(
$adjConOverlap == 0
|| $adjConOverlap <= ( 3.75 * $avgLeftUnaligned**0.48 - 47 ) *
$elementDistanceFactor**2 * $divDiff
)
&& $divDiff > 0.1 # I'm being generous here
&& $consensusGap <=
$elementDistanceFactor * $divDiff * $avgLeftUnaligned / 1.4
)
{
# consensus gap should be allowed to be larger the more 5'
# you get, since these regions are getting rarer
#print STDERR "****DISTFINE SET*****\n";
print STDERR " -- We call this good!\n" if ( $DEBUG );
$score = 1;
}
}
elsif ( $DEBUG ) {
print STDERR "scoreLINEPair(): Names Not Compat Rule\n";
} # ...if ( $namesCompat...
}
elsif ( $DEBUG ) {
print STDERR "scoreLINEPair(): Invalid Model Order or "
. "Insufficient Unaligned\n";
} # if ( $modelCompat...
}
elsif ( $DEBUG ) {
print STDERR "scoreLINEPair(): Invalid Consensus Order\n";
} # Do consensus positions make sense?
#
# Determine ShortHitName Compat
#
my $shortHitNameCompatible = 0;
my $HitName = $rightAnnot->getHitName();
$HitName =~ s/_orf2$//;
# TODO: This is a special case of an element which needs
# a portion of it's sequence masked out in a separate stage.
# The sequence is a simple repeats which is scored too high
# otherwise. I am refering to the endX designation.
$HitName =~ s/(.*)_[35]endX?$/$1/;
$HitName =~ s/_strong$//;
# could use latter as a general tool to indicate a diagnostic fragment
# rename carnivore LINEs who's name have been adjusted
# temporarily to allow neighboring fragment recognition
if ( $HitName =~ /^L1_Ca/ ) {
$HitName =~ s/^L1_Canis0/L1_Cf/;
$HitName =~ s/^L1_Canis4/L1_Canid/;
$HitName =~ s/^L1_Canis5/L1_Canid2/;
}
my $shortHitName = $HitName;
if ( $HitName =~ /^L1M/ ) {
$shortHitName =~ s/(^\w{5}).*/$1/;
}
elsif ( $optRef->{'mammal'} && $HitName =~ /^L1_/ ) {
$shortHitName = "L1_";
}
else {
$shortHitName =~ s/(\S+\d)[a-zA-Z]$/$1/;
}
$shortHitName = quotemeta $shortHitName;
my $leftHitName = $leftAnnot->getHitName();
$leftHitName =~ s/_orf2$//;
$leftHitName =~ s/(.*)_[35]endX?$/$1/;
$leftHitName =~ s/_strong$//;
if ( $leftHitName =~ /^L1_Ca/ ) {
$leftHitName =~ s/^L1_Canis0/L1_Cf/;
$leftHitName =~ s/^L1_Canis4/L1_Canid/;
$leftHitName =~ s/^L1_Canis5/L1_Canid2/;
}
print STDERR "scoreLINEPair(): shortHitName = $shortHitName\n"
if ( $DEBUG );
if ( $leftHitName =~ /^$shortHitName/ ) {
$shortHitNameCompatible = 1;
print STDERR "scoreLINEPair(): shortHitNameCompatible -- yes\n"
if ( $DEBUG );
}
#
# Less stringent compatability test
#
# shortHitNameCompatible
# gapMax = 2500 -> 3750 ( names exact )
# divDiff = abs( div1 - div2 )
# gapMax decreases with greater divDiff
# gapMax decreases with greater annotation distance
#
if ( $score == 0 && $shortHitNameCompatible ) {
print STDERR "scoreLINEPair(): last chance test ( names compat )\n"
if ( $DEBUG );
my $gapMax = 2500;
$gapMax *= 1.5
if ( $leftAnnot->getHitName() eq $rightAnnot->getHitName() );
# Need to revise the way div diff is calc'd
my $divDiff = $leftAnnot->getPctSubst() - $rightAnnot->getPctSubst();
$divDiff = -$divDiff if ( $divDiff < 0 );
$gapMax *= ( 10 - $divDiff ) / 10;
$gapMax *= ( 10 - $elementDistance ) / 10;
if ( $DEBUG ) {
print STDERR " divDiff = $divDiff\n";
print STDERR " gapMax = $gapMax > cg="
. $leftAnnot->getConsensusGap( $rightAnnot ) . "\n";
}
if ( $leftAnnot->getConsensusOverlap( $rightAnnot ) < 33
&& $leftAnnot->getConsensusOverlap( $rightAnnot ) > -$gapMax )
{
print STDERR "scoreLINEPair(): Hmmm....questionable...but "
. "going to do it\n"
if ( $DEBUG );
$score = 0.5;
}
}
#
# What is this catching???
#
# - The sequences overlap ( but not contain )
# - The sequences are shortHitNameCompatible
# - Query Overlap is >= 33
# - Consensus Overlap is < 50
#
if ( $score == 0 ) {
print STDERR "scoreLINEPair(): lastiness test\n"
if ( $DEBUG );
if ( $leftAnnot->getSeq1End() >= $rightAnnot->getSeq1Beg()
&& $rightAnnot->getSeq1End() > $leftAnnot->getSeq1End() )
{
#
# If these elements have the same class, orientation,
# similar names with small overlap or simply just
# a large overlap then join them!!! Arghhh
#
if ( $shortHitNameCompatible
&& $rightAnnot->getSeq1Beg() <= $leftAnnot->getSeq1End() - 33
&& $leftAnnot->getConsensusOverlap( $rightAnnot ) < 50 )
{
if ( !$namesCompat ) {
#warn "Must add "
# . $leftAnnot->getHitName() . " and "
# . $rightAnnot->getHitName()
# . " to the compat hash\n";
}
print STDERR "scoreLINEPair(): Well if you insist\n" if ( $DEBUG );
$score = 0.25;
}
}
}
}
elsif ( $DEBUG ) {
print STDERR "scoreLINEPair(): Wrong Seq or Orientation Rule\n";
} # Same queryName and Same orientation
if ( $score ) {
my $conOverlapFactor = -1;
$conOverlapFactor = 1 / abs( $adjConOverlap + $queryOverlap )
if ( $adjConOverlap + $queryOverlap != 0 );
if ( $DEBUG ) {
print STDERR "adjConOverlap = $adjConOverlap + "
. "queryOverlap = $queryOverlap conOverlapFactor "
. "= $conOverlapFactor\n";
print STDERR "score = $score\n";
}
if ( $conOverlapFactor > 0 ) {
$score += $conOverlapFactor;
}
else {
print STDERR "Using elementdistance = $elementDistance\n" if ( $DEBUG );
$score += 1 / $elementDistance;
}
}
print STDERR "scoreLINEPair(): Final Score = $score\n"
if ( $DEBUG );
return ( $score );
}
sub areLINENamesCompat {
my $line1 = shift;
my $line2 = shift;
# If name incompatible then return low score early
my $compat = 0;
my $line1Name = $line1->getHitName();
my $line1ClassName = $line1->getClassName();
my $line2Name = $line2->getHitName();
my $line2ClassName = $line2->getClassName();
# Establish position order
my $leftAnnot = $line1;
my $rightAnnot = $line2;
if ( $line1->comparePositionOrder( $line2 ) > 0 ) {
$leftAnnot = $line2;
$rightAnnot = $line1;
}
my $queryOverlap = $rightAnnot->getQueryOverlap( $leftAnnot );
if ( $line1->getSeq2Name() eq $line2->getSeq2Name() ) {
$compat = 1;
}
elsif ( defined $RepeatAnnotationData::lineHash{$line1Name}->{$line2Name} ) {
my $overlapThresh =
$RepeatAnnotationData::lineHash{$line1Name}->{$line2Name}
->{'overThresh'};
if ( $overlapThresh >= 0 ) {
$compat = 1
if ( $overlapThresh == 0
|| ( $queryOverlap > $overlapThresh ) );
}
}
elsif ( defined $RepeatAnnotationData::lineHash{$line2Name}->{$line1Name} ) {
my $overlapThresh =
$RepeatAnnotationData::lineHash{$line2Name}->{$line1Name}
->{'overThresh'};
if ( $overlapThresh >= 0 ) {
$compat = 1
if ( $overlapThresh == 0
|| ( $queryOverlap > $overlapThresh ) );
}
}
else {
print STDERR "Names not compatible\n" if ( $DEBUG );
}
return ( $compat );
}
#
#
# Given a fragment annotation "c" and a set of
# putative related fragments M. Also given a
# set of transforms "transforms()" for c and
# members of M.
#
# for all transforms of "c" find the maximal
# scoring transform where maximal is determined
# by the transform which is compatible with the
# most elements of M.
#
# foreach transform "tc" in transforms("c")
# foreach element "m" in M
# foreach transform "tm" in transforms("m")
# is "tc" + "m" + "tm" compatible?
#
#
# Things to consider:
# - Perhaps the score should consider
# the liklihood that two annotations
# would be fused? i.e. minimize the
# consensus gap distance??
#
# - It would be parsomonious to choose
# the set name which covers the most
# of the given consensus.
#
#
sub joinDNATransposonFragments {
my $chainBegHash = shift;
my $chainEndHash = shift;
my $repeatDB = shift;
my $currentAnnot = shift;
my $dnaTransposonCluster = shift;
$DEBUG = 0;
if ( $DEBUG ) {
print STDERR "joinDNATransposonFragments(): Entered...\n";
print STDERR " Considering Element:\n ";
$currentAnnot->printBrief();
print STDERR " Neighbor Cluster:\n";
foreach my $potAnnot ( @{$dnaTransposonCluster} ) {
print STDERR " ";
$potAnnot->printBrief();
}
print STDERR "\n";
}
##### TESTING
next if ( $currentAnnot->getRightLinkedHit() );
my ( $curHitName, $curClassName ) =
split( /\#/, $currentAnnot->getSeq2Name() );
my $curEquivHash = $currentAnnot->getEquivHash();
$curEquivHash = {} if ( !defined $curEquivHash );
my @curNames = ( $curHitName, ( sort ( keys( %{$curEquivHash} ) ) ) );
my %nameScores = ();
my %nameAnnots = ();
my $proposedName = "";
my $isCompatible = 0;
my ( $adjCurBegin, $adjCurEnd );
my ( $adjCandidateBegin, $adjCandidateEnd );
my $highestScore = 0;
my $highName = "";
my $highCurRange;
my $highMembers;
#
# Consider all names that the current element may go by
# including it's current name and all aliases.
#
foreach my $curName ( @curNames ) {
print STDERR " Current Element Name: $curName\n" if ( $DEBUG );
# Fake a range if hit name
my @curRanges = ();
if ( $curName eq $curHitName ) {
push @curRanges,
{
'start' => 1,
'end' => $chainEndHash->{ $currentAnnot->getID() },
'eqstart' => 1,
'eqend' => $chainEndHash->{ $currentAnnot->getID() }
};
}
if ( defined $curEquivHash->{$curName} ) {
push @curRanges, @{ $curEquivHash->{$curName} };
}
my $highestRangeScore = 0;
my $highestScoringCurRange = undef;
my $highestScoringMembers;
foreach my $curNameRange ( @curRanges ) {
print STDERR " Current Element Range: [$curNameRange->{'start'}-"
. "$curNameRange->{'end'}]-->[$curNameRange->{'eqstart'}-"
. "$curNameRange->{'eqend'}]\n"
if ( $DEBUG );
my $curNameRangeScore = 0;
my @curNameRangeAnnots = ();
( $adjCurBegin, $adjCurEnd ) = &translateCoord(
$currentAnnot->getSeq2Beg(),
$currentAnnot->getSeq2End(),
$curNameRange
);
my $curNameRangeLastBegin = $adjCurBegin;
my $curNameRangeLastEnd = $adjCurEnd;
my $seedSeq1Pos = $currentAnnot->getSeq1Beg();
my $seedSeq1End = $currentAnnot->getSeq1End();
foreach my $potAnnot ( @{$dnaTransposonCluster} ) {
## Don't consider fragments that would be
## inherited from the first one.
## TODO: Doesn't it make more sense to not consider
## currentAnnots with RightLinkedHits?
next if ( $potAnnot->getLeftLinkedHit() );
my ( $potHitName, $potClassName ) =
split( /\#/, $potAnnot->getSeq2Name() );
my $potEquivHash = $potAnnot->getEquivHash();
$potEquivHash = {} if ( !defined $potEquivHash );
my @potNames = ( $potHitName, ( sort ( keys( %{$potEquivHash} ) ) ) );
my $adjPotStrand = $potAnnot->getRevComp();
if ( $DEBUG ) {
print STDERR " Potential Element:\n " if ( $DEBUG );
$potAnnot->printBrief() if ( $DEBUG );
}
foreach my $potName ( @potNames ) {
# Fake a range if hit name
my @potRanges = ();
if ( $potName eq $potHitName ) {
push @potRanges,
{
'start' => 1,
'end' => $chainEndHash->{ $potAnnot->getID() },
'eqstart' => 1,
'eqend' => $chainEndHash->{ $potAnnot->getID() }
};
}
if ( defined $potEquivHash->{$potName} ) {
push @potRanges, ( @{ $potEquivHash->{$potName} } );
}
foreach my $potNameRange ( @potRanges ) {
# Test comparison
print STDERR " Equiv Names: "
. "$potName: ["
. $potNameRange->{"start"} . "-"
. $potNameRange->{"end"} . "]-->["
. $potNameRange->{"eqstart"} . "-"
. $potNameRange->{"eqend"} . "]\n"
if ( $DEBUG );
if ( $curName eq $potName ) {
# Are the orientations correct?
if (
(
$potNameRange->{'compl'} == $curNameRange->{'compl'}
&& $currentAnnot->getRevComp() eq $potAnnot->getRevComp()
)
|| ( $potNameRange->{'compl'} != $curNameRange->{'compl'}
&& $currentAnnot->getRevComp() ne $potAnnot->getRevComp() )
)
{
( $adjCandidateBegin, $adjCandidateEnd ) = &translateCoord(
$potAnnot->getSeq2Beg(),
$potAnnot->getSeq2End(),
$potNameRange
);
# Are the coordinates sensible?
if ( $potAnnot->getRevComp() eq "C"
&& defined $potNameRange->{'compl'} )
{
$adjPotStrand = "+";
}
elsif ( $potAnnot->getRevComp() eq "+"
&& defined $potNameRange->{'compl'} )
{
$adjPotStrand = "C";
}
#$adjCurBegin, $adjCurEnd,
$isCompatible = &isTransposonPairCompatible(
1, $curNameRangeLastBegin,
$curNameRangeLastEnd, $adjCandidateBegin,
$adjCandidateEnd, $adjPotStrand,
$seedSeq1Pos, $seedSeq1End,
$potAnnot->getSeq1Beg(), $potAnnot->getSeq1End()
);
if ( $isCompatible ) {
print STDERR " ---> isCompatible = $isCompatible\n"
if ( $DEBUG );
$curNameRangeLastBegin = $adjCandidateBegin;
$curNameRangeLastEnd = $adjCandidateEnd;
# Seq1 coordinates move along as we connect fragments.
$seedSeq1Pos = $potAnnot->getSeq1Beg();
$seedSeq1End = $potAnnot->getSeq1End();
## TODO: Look into adding other factors into this score.
## Those would include, all things being equal take
## the higher scoring matches etc.
$curNameRangeScore++;
push @curNameRangeAnnots,
{ 'annot' => $potAnnot, 'range' => $potNameRange };
## TODO: Make this a recursive function or fuse overlapping
## elements first. I prefer the first option.
last;
}
} # if ( ...are orientations correct
} # are the names the same
} # foreach potNameRange
} # foreach potName
} # foreach $pot
# Update stats: We now know which name produced the highest element
# count for the current element, name, and range.
#my $highestScoringName = (sort( keys( %curNameRangeScores )))[0];
if ( $curNameRangeScore > $highestRangeScore ) {
$highestRangeScore = $curNameRangeScore;
$highestScoringCurRange = $curNameRange;
$highestScoringMembers = [ @curNameRangeAnnots ];
print STDERR " New high score = $curNameRangeScore\n" if ( $DEBUG );
}
} # foreach curNameRange
if ( $highestRangeScore > $highestScore ) {
print STDERR " New high score = $highestRangeScore\n" if ( $DEBUG );
$highestScore = $highestRangeScore;
$highName = $curName;
$highCurRange = $highestScoringCurRange;
$highMembers = [ @{$highestScoringMembers} ];
#print "Dump: " . Dumper( $highMembers ) . "\n";
}
} # foreach curName
print STDERR "\n highestScore = $highestScore\n" if ( $DEBUG );
if ( $highestScore > 0 ) {
print STDERR " highCurrentName/Range = $highName: ["
. $highCurRange->{"start"} . "-"
. $highCurRange->{"end"} . "]-->["
. $highCurRange->{"eqstart"} . "-"
. $highCurRange->{"eqend"} . "]\n"
if ( $DEBUG );
&translateAnnotation( $currentAnnot, $highCurRange, $highName, $repeatDB );
if ( $currentAnnot->getRightLinkedHit()
&& !$currentAnnot->getLeftLinkedHit() )
{
my $tmpAnnot = $currentAnnot;
while ( $tmpAnnot->getRightLinkedHit() ) {
$tmpAnnot = $tmpAnnot->getRightLinkedHit();
&translateAnnotation( $tmpAnnot, $highCurRange, $highName, $repeatDB );
}
}
# Correct the coordinates & orientation of the member elements
my $lastAnnot = $currentAnnot;
my $lastBegin = $adjCurBegin;
my $lastEnd = $adjCurEnd;
my $lastSeq1Begin = $currentAnnot->getSeq1Beg();
my $lastSeq1End = $currentAnnot->getSeq1End();
my %memberSeen = ();
foreach my $member ( @{$highMembers} ) {
print "Considering member:\n" if ( $DEBUG );
$member->{'annot'}->print() if ( $DEBUG );
my ( $memberHitName, $memberClassName ) =
split( /\#/, $member->{'annot'}->getSeq2Name() );
my ( $adjMemberBegin, $adjMemberEnd ) = &translateCoord(
$member->{'annot'}->getSeq2Beg(),
$member->{'annot'}->getSeq2End(),
$member->{'range'}
);
# First check to see if this needs to be fused
if ( $adjMemberBegin <= $lastEnd
&& $adjMemberEnd >= $lastBegin
&& $member->{'annot'}->getSeq1Beg() <= $lastSeq1Begin
&& $member->{'annot'}->getSeq1End() >= $lastSeq1End )
{
# add fused element to our derived from list
if ( $options{'source'} ) {
$lastAnnot->addDerivedFromAnnot( $member );
}
# Modify the last one
# Add bases to either the end or begining of the consensus position
#print STDERR "lastRange = $lastBegin - $lastEnd\n";
$lastAnnot->set3PrimeUnaligned(
$lastAnnot->get3PrimeUnaligned() - ( $lastEnd - $adjMemberEnd ) );
$lastAnnot->setSeq2End( $adjMemberEnd );
# Remove ourselves
$member->{'annot'}->setStatus( "DELETED" );
# Adjust other things like score, div stats etc
if ( $member->{'annot'}->getSW() > $lastAnnot->getSW() ) {
$lastAnnot->setSW( $member->{'annot'}->getSW() );
}
if ( $member->{'annot'}->getPctSubst() < $lastAnnot->getPctSubst() ) {
my $totalLastLength =
$lastAnnot->getSeq1End() - $lastAnnot->getSeq2Beg();
my $lastRemainder = $totalLastLength - getOverlapSize(
$member->{'annot'}->getSeq1Beg(),
$member->{'annot'}->getSeq1End(),
$lastAnnot->getSeq1Beg(),
$lastAnnot->getSeq1End()
);
$lastAnnot->setPctSubst(
$member->{'annot'}->getPctSubst() + (
$lastAnnot->getPctSubst() * ( $lastRemainder / $totalLastLength )
)
);
$lastAnnot->setPctDelete(
$member->{'annot'}->getPctDelete() + (
$lastAnnot->getPctDelete() * ( $lastRemainder / $totalLastLength )
)
);
$lastAnnot->setPctInsert(
$member->{'annot'}->getPctInsert() + (
$lastAnnot->getPctInsert() * ( $lastRemainder / $totalLastLength )
)
);
}
else {
my $totalLastLength =
$member->{'annot'}->getSeq1End() -
$member->{'annot'}->getSeq2Beg();
my $lastRemainder = $totalLastLength - getOverlapSize(
$lastAnnot->getSeq1Beg(),
$lastAnnot->getSeq1End(),
$member->{'annot'}->getSeq1Beg(),
$member->{'annot'}->getSeq1End()
);
$member->{'annot'}->setPctSubst(
$lastAnnot->getPctSubst() + (
$member->{'annot'}->getPctSubst() *
( $lastRemainder / $totalLastLength )
)
);
$member->{'annot'}->setPctDelete(
$lastAnnot->getPctDelete() + (
$member->{'annot'}->getPctDelete() *
( $lastRemainder / $totalLastLength )
)
);
$member->{'annot'}->setPctInsert(
$lastAnnot->getPctInsert() + (
$member->{'annot'}->getPctInsert() *
( $lastRemainder / $totalLastLength )
)
);
}
# Adjust seq1positions
}
else {
&translateAnnotation( $member->{'annot'}, $member->{'range'}, $highName,
$repeatDB );
if ( $member->{'annot'}->getRightLinkedHit()
&& !$member->{'annot'}->getLeftLinkedHit() )
{
my $tmpAnnot = $member->{'annot'};
while ( $tmpAnnot->getRightLinkedHit() ) {
$tmpAnnot = $tmpAnnot->getRightLinkedHit();
&translateAnnotation( $tmpAnnot, $member->{'range'},
$highName, $repeatDB );
}
}
if ( $DEBUG ) {
print STDERR " Doing the join of\n" if ( $DEBUG );
$lastAnnot->print();
$member->{'annot'}->print();
}
$lastAnnot->join( $member->{'annot'} );
$lastAnnot = $member->{'annot'};
$lastEnd = $adjMemberEnd;
$lastBegin = $adjMemberBegin;
$lastSeq1Begin = $member->{'annot'}->getSeq1Beg();
$lastSeq1End = $member->{'annot'}->getSeq1End();
} # is fusable else
} # end foreach
if ( $DEBUG ) {
print STDERR " New current element:\n ";
$currentAnnot->printBrief();
print STDERR " New member elements:\n";
foreach my $member ( @{$highMembers} ) {
print STDERR " " . $member->{'annot'}->getStatus() . ":";
$member->{'annot'}->printBrief();
}
}
}
print STDERR "joinDNATransposonFragments(): Exiting...\n\n" if ( $DEBUG );
}
sub translateAnnotation {
my $annot = shift;
my $transRange = shift;
my $transName = shift;
my $repeatDB = shift;
# Correct the coordinates & orientation of the current element first
my ( $curHitName, $curClassName ) =
split( /\#/, $annot->getSeq2Name() );
my ( $adjCurBegin, $adjCurEnd ) =
&translateCoord( $annot->getSeq2Beg(), $annot->getSeq2End(),
$transRange );
# Modify end coordinates and left unaligned if necessary.
if ( $adjCurEnd == $annot->getSeq2End()
&& $curHitName eq $transName )
{
# Nothing to do...coordinates didn't change.
}
elsif ( defined $repeatDB->{ lc( $transName ) }->{'conlength'} ) {
$annot->setSeq2End( $adjCurEnd );
$annot->set3PrimeUnaligned(
$repeatDB->{ lc( $transName ) }->{'conlength'} - $annot->getSeq2End() );
}
else {
die "Cannot find the consensus length for element $transName!\n"
. "consensus unaligned length will be incorrect in the\n"
. "annotation. Annotation is\n"
. $annot->print() . "\n";
}
# If we are changing the name we might have changed the class as well.
if ( defined $repeatDB->{ lc( $transName ) } ) {
my $className = $repeatDB->{ lc( $transName ) }->{'type'};
if ( $repeatDB->{ lc( $transName ) }->{'subtype'} ne "" ) {
$className .= "/" . $repeatDB->{ lc( $transName ) }->{'subtype'};
}
$annot->setClassName( $className );
}
$annot->setHitName( $transName );
$annot->setSeq2Beg( $adjCurBegin );
$annot->setStatus( "JOINED" );
if ( $annot->getRevComp() eq "C"
&& defined $transRange->{'compl'} )
{
$annot->setRevComp( "+" );
}
elsif ( $annot->getRevComp() eq "+"
&& defined $transRange->{'compl'} )
{
$annot->setRevComp( "C" );
}
} # sub translateAnnotation
##sorting subroutines
# Cycle 0B
sub bySeqSWConbegin ($$) {
( $_[ 0 ]->getSeq1Name() ) cmp( $_[ 1 ]->getSeq1Name() )
|| ( $_[ 0 ]->getSW() ) <=> ( $_[ 1 ]->getSW() )
|| ( $_[ 0 ]->getSeq2Beg() ) <=> ( $_[ 1 ]->getSeq2Beg() );
}
# Lots of places
sub byNameBeginEndrevSWrev ($$) {
( $_[ 0 ]->getSeq1Name() ) cmp( $_[ 1 ]->getSeq1Name() )
|| ( $_[ 0 ]->getSeq1Beg() ) <=> ( $_[ 1 ]->getSeq1Beg() )
|| ( $_[ 1 ]->getSeq1End() ) <=> ( $_[ 0 ]->getSeq1End() )
|| ( $_[ 1 ]->getSW() ) <=> ( $_[ 0 ]->getSW() );
### note: takes the longer sequence starting at the same position first
}
# Cycle 0Da
sub byNameClassBeginEndrevAndSWrev ($$) {
my ( $aSeqName, $aClassName ) = $_[ 0 ]->getSeq2Name() =~ /(.*)#(.*)/;
my ( $bSeqName, $bClassName ) = $_[ 1 ]->getSeq2Name() =~ /(.*)#(.*)/;
( $_[ 0 ]->getSeq1Name() ) cmp( $_[ 1 ]->getSeq1Name() )
|| ( $aClassName ) cmp( $bClassName )
|| ( $_[ 0 ]->getSeq1Beg() ) <=> ( $_[ 1 ]->getSeq1Beg() )
|| ( $_[ 1 ]->getSeq1End() ) <=> ( $_[ 0 ]->getSeq1End() )
|| ( $_[ 1 ]->getSW() ) <=> ( $_[ 0 ]->getSW() );
}
# Line Preprocessing notes:
#
#
# TODO: Eventually this routine should keep track of the adjustments
# independent of the original annotation. That way we can
# track the evidence for each final annotation.
#
# Marsupials are adjusted to L1_Mdo1
# To be done: HAL1_Opos1_3end is not so close to normal LINE1s,
# but probably still warrants to be lined up with L1.
# opt_mammals and L1* are adjusted to L1_Canid
# in future all mammalian LINEs need to have one startpoint, e.g. L1M2_ORF2
# We change L1_Cf so that it can be recognized in fragment comparisons
# with L1_Canis subs. Similarly for L1_Canid.
#
# LINE subfamilies have widely variable length 5' ends. To be able to
# merge closely related LINE subfamilies, the positions need to be
# adjusted to a standard. The ORF2 is basically of identical length
# between all known subfamilies, so the start of ORF2 is probably the
# best place to match the positions of the 5' end consensus
# sequences. I've taken L1PA2 as a standard for L1, where ORF2 starts
# at 2110. Many 5' end consensus sequences extend to overlap 150 bp
# with the ORF2, but many others only describe sequences further 5' in
# the element, usually because another subfamily has a very closely
# matching sequence over ORF1.
# The "left over in the consensus sequence" number (now reflecting
# how far the consensus extends 3') is adjusted to reflect what
# would be left in a full element (add 3294 for ORF2 + length best
# matching 3' end consensus - 2x 150 bp for overlaps)
# The first number fed to ChangePos is subtracted from the given
# position. Thus, a consensus that is longer than the standard
# gets a positive number, one that is shorter a negative number.
# When making adjustments dependent on position in consensus with the
# subroutine ChangePos begin-limit of doing so should be >= or <
# end-limit when the position number is decreased or increased, resp.
# L1PA4 ORF2 start 2110; L1 ORF2 length 3294 bp
#
#
# L1P4b-e are adjusted to L1P4a
# L1MEf_5end -- 3'end not yet known; used same as L1MDa
# L1MEg_5end -- 3' end not yet known; used same as L1MDa
# L3b, L3_Mars -- Are adjust to the ancient L3 consensus, even
# if this consensus is incomplete. If this consensus is
# updated, these adjustments need to be changed
sub preProcessLINE {
my $chainBegHash = shift;
my $chainEndHash = shift;
my $conPosCorrHash = shift;
my $annot = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "preProcessLINE(): Before preprocessing\n";
$annot->print();
}
my $HitName = $annot->getHitName();
my $ID = $annot->getID();
if ( defined $RepeatAnnotationData::preProcData{$HitName} ) {
my $adjChainBeg = 0;
my $adjChainEnd = 0;
# Adjust consensus positions
if (
defined $RepeatAnnotationData::preProcData{$HitName}->{'relToReference'} )
{
$annot->setSeq2Beg( $annot->getSeq2Beg() +
$RepeatAnnotationData::preProcData{$HitName}->{'relToReference'} );
$annot->setSeq2End( $annot->getSeq2End() +
$RepeatAnnotationData::preProcData{$HitName}->{'relToReference'} );
$adjChainBeg =
$chainBegHash->{$ID} +
$RepeatAnnotationData::preProcData{$HitName}->{'relToReference'};
$adjChainEnd =
$chainEndHash->{$ID} +
$RepeatAnnotationData::preProcData{$HitName}->{'relToReference'};
# I.e _5ends and full length elements?
# TODO: Make this a function is3End isOrf etc..
unless ( $HitName =~ /_3end|_orf2/ ) {
$conPosCorrHash->{$ID} =
-$RepeatAnnotationData::preProcData{$HitName}->{'relToReference'};
}
}
# Adjust LeftUnaligned
if ( defined $RepeatAnnotationData::preProcData{$HitName}->{'3EndLength'} )
{
$annot->set3PrimeUnaligned( $annot->get3PrimeUnaligned() +
$RepeatAnnotationData::preProcData{$HitName}->{'3EndLength'} );
}
# Rename based on adjusted consensus coordinates
if ( defined $RepeatAnnotationData::preProcData{$HitName}->{'rangeNames'} )
{
foreach my $range (
@{ $RepeatAnnotationData::preProcData{$HitName}->{'rangeNames'} } )
{
my $newHitName = $annot->getHitName();
# range has maxEnd
if ( defined $range->{'maxEnd'} && $DEBUG ) {
print STDERR "Considering maxEnd= "
. $range->{'maxEnd'}
. " and hitname = "
. $range->{'name'}
. " and adjchainend=$adjChainEnd\n";
}
if ( defined $range->{'maxEnd'}
&& $adjChainEnd <= $range->{'maxEnd'} )
{
$newHitName = $range->{'name'};
}
#
if ( defined $range->{'maxArianEndScore'}
&& ( $adjChainEnd + $annot->getSW() ) <=
$range->{'maxArianEndScore'} )
{
$newHitName = $range->{'name'};
}
#
if ( defined $range->{'minBeg'}
&& $adjChainBeg >= $range->{'minBeg'} )
{
$newHitName = $range->{'name'};
}
#
if ( defined $range->{'relLeftUnaligned'}
&& $HitName ne $newHitName )
{
$annot->set3PrimeUnaligned(
$annot->get3PrimeUnaligned() + $range->{'relLeftUnaligned'} );
}
#
$annot->setHitName( $newHitName );
}
}
}
if ( $DEBUG ) {
print STDERR "After preprocessing\n";
$annot->print();
print STDERR "cons pos correction = " . $conPosCorrHash->{$ID} . "\n";
}
}
sub preProcessDNATransp {
my $chainBegHash = shift;
my $chainEndHash = shift;
my $annot = shift;
my $repeatDB = shift;
if ( defined $repeatDB->{ lc( $annot->getHitName() ) } ) {
my $dbRec = $repeatDB->{ lc( $annot->getHitName() ) };
$DEBUG = 0;
if ( defined $dbRec->{'equiv'} ) {
my $rangeSlack = 6;
my %compHash = ();
foreach my $equivRec ( @{ $dbRec->{'equiv'} } ) {
# Sorted in start order
foreach my $rangeRec ( @{ $equivRec->{'ranges'} } ) {
# No need to check ranges which start after we end
last if ( $chainEndHash->{ $annot->getID() } < $rangeRec->{'start'} );
# Are we contained in this range? Leave some range slack
# for search run through.
if ( $chainBegHash->{ $annot->getID() } >=
$rangeRec->{'start'} - $rangeSlack
&& $chainEndHash->{ $annot->getID() } <=
$rangeRec->{'end'} + $rangeSlack )
{
# Contained by a non-unique range
# Not uniq to this consensus...push comparable
push @{ $compHash{ $equivRec->{'name'} } }, $rangeRec;
}
}
}
if ( keys %compHash ) {
if ( $DEBUG ) {
print STDERR "\n\n***NOT UNIQUE***\n";
$annot->print();
print STDERR "Comps:\n";
foreach my $key ( keys( %compHash ) ) {
print STDERR "$key: " . Dumper( $compHash{$key} ) . "\n";
}
}
$annot->setEquivHash( {%compHash} );
}
$DEBUG = 0;
}
}
}
# Temporarily adjusts consensus sequence position info to allow
# merging of matches to different subfamilies. The position is usually
# later readjusted based on the "conPosCorrection" hash. Note that positive
# numbers fed to the subroutine are subtracted (longer subfamilies are
# adjusted with higher numbers, shorter with negatives)
sub ChangePos {
my $chainBegHash = shift;
my $chainEndHash = shift;
my $conPosCorrHash = shift;
my $annot = shift;
my $ID = $annot->getID();
$conPosCorrHash->{$ID} = shift;
$annot->setSeq2Beg( $annot->getSeq2Beg() - $conPosCorrHash->{$ID} );
$chainBegHash->{$ID} -= $conPosCorrHash->{$ID};
$annot->setSeq2End( $annot->getSeq2End() - $conPosCorrHash->{$ID} );
$chainEndHash->{$ID} -= $conPosCorrHash->{$ID};
$annot->set3PrimeUnaligned( $annot->get3PrimeUnaligned() + $_[ 0 ] )
if $_[ 0 ];
}
#
# Returns overlap size for a range.
#
# TODO: Replace this with getQueryOverlap in object
#
sub getOverlapSize {
my $range1Begin = shift;
my $range1End = shift;
my $range2Begin = shift;
my $range2End = shift;
my $overlap = 0;
if ( $range1Begin >= $range2Begin
&& $range1Begin <= $range2End )
{
# -------
# ------
# or
# -----
# --------
if ( $range1End <= $range2End ) {
# -----
# --------
$overlap = $range1End - $range1Begin + 1;
}
else {
# -------
# ------
$overlap = $range2End - $range1Begin + 1;
}
}
elsif ( $range1End >= $range2Begin
&& $range1End <= $range2End )
{
# -------
# ------
# or
# --------
# -----
if ( $range1End >= $range2End ) {
# --------
# -----
$overlap = $range2End - $range2Begin + 1;
}
else {
# -------
# ------
$overlap = $range1End - $range2Begin + 1;
}
}
return $overlap;
}
sub isTransposonPairCompatible {
my $cycle = shift;
my $adjCurBegin = shift;
my $adjCurEnd = shift;
my $adjNextBegin = shift;
my $adjNextEnd = shift;
my $curStrand = shift;
my $curBeginAlign = shift;
my $curEndAlign = shift;
my $nextBeginAlign = shift;
my $nextEndAlign = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR " adjCurBegEndStrand=$adjCurBegin $adjCurEnd $curStrand\n";
print STDERR " adjNextBegEnd=$adjNextBegin $adjNextEnd\n";
}
my $conGap;
my $conExt = 0;
if ( $curStrand ne "C" ) {
# ---current---> (gap) ---next--->
$conGap = $adjNextBegin - $adjCurEnd;
$conExt = ( $adjNextEnd - $adjNextBegin + 1 ) - $conGap;
}
else {
# <--current--- (gap) <--next---
$conGap = $adjCurBegin - $adjNextEnd;
$conExt = ( $adjNextEnd - $adjNextBegin + 1 ) - $conGap;
}
my $seqGap;
if ( $curBeginAlign > $nextEndAlign ) {
# ---next--- (gap) ---current---
$seqGap = $curBeginAlign - $nextEndAlign - 1;
}
else {
# ---current--- (gap) ---next---
$seqGap = $nextBeginAlign - $curEndAlign - 1;
}
## TODO: Do not attach pieces to complete consensi
print STDERR "conGap = $conGap, seqGap = $seqGap: "
. "Is conGap > -75 && ( conGap < 500 )\n"
if ( $DEBUG );
if (
$conGap > -75
&& $conGap < 500
&& ( ( $curStrand eq "C" && $adjCurBegin - $conExt > -10 ) )
## TODO: Must check that we don't go beyond the length
## of the adjusted consensus.
)
{
return ( 1 );
}
return ( 0 );
}
##
##
##
sub translateCoord {
my $unBegin = shift;
my $unEnd = shift;
my $transHash = shift;
## Correction for run-through ranges
$unBegin = $transHash->{'start'} if ( $unBegin < $transHash->{'start'} );
$unEnd = $transHash->{'end'} if ( $unEnd > $transHash->{'end'} );
my $rangeLen = $transHash->{'end'} - $transHash->{'start'} + 1;
my $eqRangeLen = $transHash->{'eqend'} - $transHash->{'eqstart'} + 1;
my $conBegin = sprintf(
"%0.d",
(
(
( $unBegin - $transHash->{'start'} ) * $eqRangeLen
) / $rangeLen
) + $transHash->{'eqstart'}
);
my $conEnd = sprintf(
"%0.d",
(
( ( $unEnd - $transHash->{'start'} ) * $eqRangeLen ) /
$rangeLen
) + $transHash->{'eqstart'}
);
return ( $conBegin, $conEnd );
}
#
# isTooDiverged():
#
# Return true of past element substitution percentage is 2x as
# high *and* greater than 10% higher than the current elements
# substitution percentage.
#
# A true value indicates that the past element is neither likely to
# be related to the current element nor is it likely that a
# fragment of the younger current element lies beyond the past element.
#
sub isTooDiverged {
my $currentElementPctSub = shift;
my $pastElementPctSub = shift;
$pastElementPctSub > 2 * $currentElementPctSub
&& $pastElementPctSub > $currentElementPctSub + 10;
}
sub printHitArrayList {
my $sortedAnnotationsList = shift;
my $cycleAnnotIter = $sortedAnnotationsList->getIterator();
my %newID = ();
my $ind = 1;
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
if ( $currentAnnot->getLeftLinkedHit()
&& $newID{ $currentAnnot->getLeftLinkedHit()->getUniqID() } > 0 )
{
$newID{ $currentAnnot->getUniqID() } =
$newID{ $currentAnnot->getLeftLinkedHit()->getUniqID() };
}
else {
$newID{ $currentAnnot->getUniqID() } = $ind++;
}
}
$cycleAnnotIter = $sortedAnnotationsList->getIterator();
print STDERR "RESULTS OF JOINS\n";
while ( $cycleAnnotIter->hasNext() ) {
my $currentAnnot = $cycleAnnotIter->next();
$currentAnnot->print( 1 );
print STDERR "" . $newID{ $currentAnnot->getUniqID() } . " ";
print STDERR "<-" if ( $currentAnnot->getLeftLinkedHit() );
print STDERR "->" if ( $currentAnnot->getRightLinkedHit() );
print STDERR "\n";
if ( $currentAnnot->getSW() == 8027
&& $currentAnnot->getLeftLinkedHit() )
{
print STDERR " <=== ";
$currentAnnot->getLeftLinkedHit()->print( 1 );
print STDERR "\n";
}
}
print STDERR "END RESULTS OF JOINS\n";
}
sub scoreRefinedSINEPair {
my $annot1 = shift;
my $annot2 = shift;
my $compatibleDistance = shift;
# Establish position order
my $DEBUG = 0;
my $leftAnnot = $annot1;
my $rightAnnot = $annot2;
if ( $annot1->comparePositionOrder( $annot2 ) > 0 ) {
$leftAnnot = $annot2;
$rightAnnot = $annot1;
}
if ( $DEBUG ) {
print STDERR " scoreRefinedSINEPair():\n ";
$leftAnnot->print();
print STDERR " vs ";
$rightAnnot->print();
}
my $score = 0;
if (
$leftAnnot->getHitName() eq $rightAnnot->getHitName()
&& $rightAnnot->getRevComp() eq $leftAnnot->getRevComp()
&& $rightAnnot->getQueryOverlap( $leftAnnot ) <= 21
&& -( $rightAnnot->getConsensusOverlap( $leftAnnot ) ) <= 100
&& -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) <= 1000
&& ( $rightAnnot->getConsensusOverlap( $leftAnnot ) <= 21
|| -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) < 0
&& $rightAnnot->getConsensusOverlap( $leftAnnot ) -
$rightAnnot->getQueryOverlap( $leftAnnot ) <= 20 )
)
{
my $gap = $rightAnnot->getSeq1Beg() - $leftAnnot->getSeq1End();
$gap = 1 if ( $gap == 0 );
$score =
( $rightAnnot->getSW() + $leftAnnot->getSW() ) *
( 1 / ( $compatibleDistance ) ) * ( 1 / ( $gap ) );
if ( $DEBUG ) {
print STDERR "scoreRefinedSINEPair(): Scoring ( $score ) [ "
. ( $rightAnnot->getSeq1Beg() - $leftAnnot->getSeq1End() )
. " ] to:" . "\n";
print STDERR " -> ";
$leftAnnot->print();
print STDERR " -> ";
$rightAnnot->print();
}
}
print STDERR "newScore.... score = $score\n" if ( $DEBUG );
return $score;
}
sub scoreGenericPair {
my $annot1 = shift;
my $annot2 = shift;
my $elementDistance = shift;
my $classElementDistance = shift;
# Establish position order
my $DEBUG = 0;
my $leftAnnot = $annot1;
my $rightAnnot = $annot2;
if ( $annot1->comparePositionOrder( $annot2 ) > 0 ) {
$leftAnnot = $annot2;
$rightAnnot = $annot1;
}
my $score = 0;
my $currentHitName = $rightAnnot->getHitName();
my $prevHitName = $leftAnnot->getHitName();
if ( $leftAnnot->getSeq1Name() eq $rightAnnot->getSeq1Name()
&& $rightAnnot->getRevComp() eq $leftAnnot->getRevComp() )
{
print STDERR " --- Same orient/seq\n" if ( $DEBUG );
print STDERR " --- qo = "
. $rightAnnot->getQueryOverlap( $leftAnnot )
. "\n co = "
. $rightAnnot->getConsensusOverlap( $leftAnnot ) . "\n"
if ( $DEBUG );
if (
$rightAnnot->getLastField == $leftAnnot->getLastField()
&& ( $currentHitName eq $prevHitName
|| $currentHitName =~ /$prevHitName/
|| $prevHitName =~ /$currentHitName/ )
&& -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) <= 10
&& -( $rightAnnot->getConsensusOverlap( $leftAnnot ) ) <= 100
&& ( $rightAnnot->getConsensusOverlap( $leftAnnot ) <= 21
|| -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) < 0
&& $rightAnnot->getConsensusOverlap( $leftAnnot ) -
$rightAnnot->getQueryOverlap( $leftAnnot ) <= 20 )
)
{
$score = 1;
}
my $HitName = $rightAnnot->getHitName();
my $shortHitName = $HitName;
$shortHitName =~ s/(\S+\d)[a-zA-Z]$/$1/;
$shortHitName = quotemeta $shortHitName;
# Less stringent
if ( $score == 0 && $leftAnnot->getHitName() =~ /^$shortHitName/ ) {
print STDERR "scoreGenericPair(): last chancy test ( names compat )\n"
if ( $DEBUG );
my $gapMax = 2500;
$gapMax *= 1.5
if ( $leftAnnot->getHitName() eq $rightAnnot->getHitName() );
# Need to revise the way div diff is calc'd
my $divDiff = $leftAnnot->getPctSubst() - $rightAnnot->getPctSubst();
print STDERR "scoreGenericPair(): gapMax = $gapMax "
. "divDiff = $divDiff elemedist = $elementDistance\n"
if ( $DEBUG );
$divDiff = -$divDiff if ( $divDiff < 0 );
$gapMax *= ( 10 - $divDiff ) / 10;
$gapMax *= ( 15 - $elementDistance ) / 15;
print STDERR "scoreGenericPair(): gapMax = $gapMax "
. "divDiff = $divDiff\n"
if ( $DEBUG );
if ( $leftAnnot->getConsensusOverlap( $rightAnnot ) < 33
&& $leftAnnot->getConsensusOverlap( $rightAnnot ) > -$gapMax )
{
print STDERR "scoreGenericPair(): Hmmm....I guess so.. " . "\n"
if ( $DEBUG );
$score = 0.5;
}
}
}
return ( $score );
}
#####################################################################
################ C O N T A I N S M E T A D A T A ################
################# metadata ################
#####################################################################
# TODO: This used to be part of the SINE code. We need to include
# a refinement MIR eventually.
# # if SINE/ALU
# # Make MIR's generic if they are not in the
# # unique regions. NOTE: Unique regions are
# # a good possibility for generalization.
# elsif ( $HitName eq 'MIR3' ) {
# if ( $chainBegHash->{$ID} >= 16
# && $chainEndHash->{$ID} <= 153 )
# {
# $HitName = 'MIR';
# }
# }
sub preProcessLTR {
my $chainBegHash = shift;
my $chainEndHash = shift;
my $conPosCorrHash = shift;
my $annot = shift;
my $ID = $annot->getID();
my $HitName = $annot->getHitName();
# all MLT2s adjusted to MLT2B3 or 4
if ( $chainBegHash->{$ID} > 180 ) {
if ( $HitName =~ /^MLT2A/ ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, -108 )
if $chainBegHash->{$ID} > 270;
}
elsif ( $HitName =~ /^MLT2B[12]$/ ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, -47 )
if $chainBegHash->{$ID} > 265;
}
elsif ( $HitName eq "MLT2B5" ) {
if ( $chainBegHash->{$ID} > 415 ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot,
162 );
}
else {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot,
116 );
}
}
elsif ( $HitName eq "MLT2C1" ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, -166 )
if $chainBegHash->{$ID} > 220;
}
elsif ( $HitName eq "MLT2C2" ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, -95 )
if $chainBegHash->{$ID} > 275;
}
elsif ( $HitName eq "MLT2D" ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, -146 )
if $chainBegHash->{$ID} > 225;
}
elsif ( $HitName eq "MLT2E" ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, 65 )
if $chainBegHash->{$ID} > 520;
}
elsif ( $HitName eq "MLT2F" ) {
&ChangePos( $chainBegHash, $chainEndHash, $conPosCorrHash, $annot, 100 )
if $chainBegHash->{$ID} > 550;
}
}
}
sub scoreSINEPair {
my $annot1 = shift;
my $annot2 = shift;
my $elementDistance = shift;
# Establish position order
my $DEBUG = 0;
my $leftAnnot = $annot1;
my $rightAnnot = $annot2;
if ( $annot1->comparePositionOrder( $annot2 ) > 0 ) {
$leftAnnot = $annot2;
$rightAnnot = $annot1;
}
my $score = 0;
my $currentHitName = $rightAnnot->getHitName();
my $prevHitName = $leftAnnot->getHitName();
if ( $leftAnnot->getSeq1Name() eq $rightAnnot->getSeq1Name()
&& $rightAnnot->getRevComp() eq $leftAnnot->getRevComp() )
{
print STDERR " --- Same orient/seq\n" if ( $DEBUG );
print STDERR " --- qo = "
. $rightAnnot->getQueryOverlap( $leftAnnot )
. "\n co = "
. $rightAnnot->getConsensusOverlap( $leftAnnot ) . "\n"
if ( $DEBUG );
if (
$rightAnnot->getLastField == $leftAnnot->getLastField()
&& ( $currentHitName eq $prevHitName
|| $currentHitName =~ /$prevHitName/
|| $prevHitName =~ /$currentHitName/ )
&& -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) <= 10
&& -( $rightAnnot->getConsensusOverlap( $leftAnnot ) ) <= 100
&& ( $rightAnnot->getConsensusOverlap( $leftAnnot ) <= 21
|| -( $rightAnnot->getQueryOverlap( $leftAnnot ) ) < 0
&& $rightAnnot->getConsensusOverlap( $leftAnnot ) -
$rightAnnot->getQueryOverlap( $leftAnnot ) <= 20 )
)
{
print STDERR " --- good score ( 1 )\n" if ( $DEBUG );
$score = 1;
}
my $HitName = $rightAnnot->getHitName();
my $shortHitName = $HitName;
if ( $HitName =~ /^Alu/ ) {
$shortHitName =~ s/(^\w{5}).*/$1/;
}
else {
$shortHitName =~ s/(\S+\d)[a-zA-Z]$/$1/;
}
$shortHitName = quotemeta $shortHitName;
# Less stringent
if ( $score == 0 && $leftAnnot->getHitName() =~ /^$shortHitName/ ) {
print STDERR "scoreSINEPair(): last chancy test ( names compat )\n"
if ( $DEBUG );
my $gapMax = 2500;
$gapMax *= 1.5
if ( $leftAnnot->getHitName() eq $rightAnnot->getHitName() );
# Need to revise the way div diff is calc'd
my $divDiff = $leftAnnot->getPctSubst() - $rightAnnot->getPctSubst();
print STDERR "scoreSINEPair(): gapMax = $gapMax "
. "divDiff = $divDiff elemedist = $elementDistance\n"
if ( $DEBUG );
$divDiff = -$divDiff if ( $divDiff < 0 );
$gapMax *= ( 10 - $divDiff ) / 10;
$gapMax *= ( 15 - $elementDistance ) / 15;
print STDERR "scoreSINEPair(): gapMax = $gapMax " . "divDiff = $divDiff\n"
if ( $DEBUG );
if ( $leftAnnot->getConsensusOverlap( $rightAnnot ) < 33
&& $leftAnnot->getConsensusOverlap( $rightAnnot ) > -$gapMax )
{
print STDERR "scoreSINEPair(): Hmmm....I guess so.. " . "\n"
if ( $DEBUG );
$score = 0.5;
}
}
}
return ( $score );
}
sub scoreLTRPair {
my $annot1 = shift;
my $annot2 = shift;
my $eleDistance = shift;
my $ltrDistance = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "scoreLTRPair(): Considering...\n";
$annot1->print();
$annot2->print();
}
# Establish position order
my $leftAnnot = $annot1;
my $rightAnnot = $annot2;
if ( $annot1->comparePositionOrder( $annot2 ) > 0 ) {
$leftAnnot = $annot2;
$rightAnnot = $annot1;
}
my $intScore = 0;
my $hybrid = 0;
# Ensure compatible names and orientation agreement
if ( &areLTRNamesCompat( $annot1, $annot2 )
&& $annot1->getRevComp() eq $annot2->getRevComp() )
{
print STDERR "scoreLTRPair(): Names are compatible\n" if ( $DEBUG );
#
# Model component specific checks
#
if ( &isInternal( $annot1 ) && &isInternal( $annot2 ) ) {
print STDERR "scoreLTRPair(): Both internals\n" if ( $DEBUG );
# Both internal
# Names are compatible loosely compatible.
my $CO = $leftAnnot->getConsensusOverlap( $rightAnnot );
my $CG = -$CO;
if ( $CO <= 111 && $CG <= 1234
|| $leftAnnot->getHitName() eq $rightAnnot->getHitName()
&& $CO <= 111
&& $CG <= 5555 )
{
print STDERR "scoreLTRPair(): INT Good One\n" if ( $DEBUG );
$intScore = 1;
}
else {
print STDERR "scoreLTRPair(): Failed: CO=$CO>111, "
. "CG=$CG>1234 etc..\n"
if ( $DEBUG );
}
}
elsif ( &isLTR( $annot1 ) && &isLTR( $annot2 ) ) {
print STDERR "scoreLTRPair(): Both ltrs\n" if ( $DEBUG );
# Both LTR
# Join if:
# Class is MaLR or
# Both are MLT2.. variations or
# Hitnames are shorthitname alike
# And
# LastFields = 5
# CG <= 220 - ( number of LTRs distant + 1 ) * 20
# CO <= 50
# Same orientation
# And
# Unaligned edges are >= 10bp long
if (
(
(
$annot1->getClassName() =~ /ERVL-MaLR/
&& $annot2->getClassName() =~ /ERVL-MaLR/
)
|| ( $annot1->getHitName() =~ /MLT2/
&& $annot2->getHitName() =~ /MLT2/ )
|| &areLTRNamesCompat( $annot1, $annot2 ) == 1
)
&& ( $annot1->getLastField() == 5 && $annot2->getLastField() == 5 )
&& ( $leftAnnot->getConsensusOverlap( $rightAnnot ) >
-( 220 - $ltrDistance * 20 ) )
&& ( $leftAnnot->getConsensusOverlap( $rightAnnot ) <= 50 )
&& ( $leftAnnot->getRevComp() eq $rightAnnot->getRevComp() )
)
{
print STDERR "scoreLTRPair(): Good distance\n" if ( $DEBUG );
if (
# --ltr--> --ltr-->
(
$annot1->getRevComp() eq "+"
&& $leftAnnot->get3PrimeUnaligned() >= 10
&& $rightAnnot->getSeq2Beg() >= 10
)
# <--ltr-- <--ltr---
|| ( $annot2->getRevComp() eq "C"
&& $leftAnnot->getSeq2Beg() >= 10
&& $rightAnnot->get3PrimeUnaligned() >= 10 )
)
{
$intScore = 1;
}
}
}
else {
# Mixture of internal and ltr
$hybrid = 1;
print STDERR "scoreLTRPair(): Mixture of ltr/internal: "
. "eleDist = $eleDistance\n"
if ( $DEBUG );
# Mixture of internal and ltr fragments
# Stringent:
# - Names are compatible: loosely compatible.
# - <= 33 bp unaligned on each fragment
# - Same orientation
# - No more than 2 insertions
# - No more than 350 bp gap in query
# No more than 2 insertions
## TODO: Should lower stringency based on the exactness of the
## flanking name.
if ( $eleDistance <= 2
&& $annot1->getQueryOverlap( $annot2 ) > -350 )
{
print STDERR "scoreLTRPair(): eleDistance OK and queryOverlap OK\n"
if ( $DEBUG );
if (
# ----> ---int--->
# ---int--> ----->
(
$annot1->getRevComp() eq "+"
&& $leftAnnot->get3PrimeUnaligned() <= 33
&& $rightAnnot->getSeq2Beg() <= 33
)
# <---- <--int---
# <---int-- <-----
|| ( $annot2->getRevComp() eq "C"
&& $leftAnnot->getSeq2Beg() <= 33
&& $rightAnnot->get3PrimeUnaligned() <= 33 )
)
{
print STDERR "scoreLTRPair(): Good One\n" if ( $DEBUG );
$intScore = 1;
}
}
}
# Less stringent
# Loose applies to all combinations of elements:
# - No more than 10,000 bp gap in query
# - Same orientation
# - No intervening element with > 1.33 * PctSubst than
# the *higher-query-position* member of the pair.
# - Similar names: shorthitname rules
# - Gap < 500
# gapallowed = 1.5*2500
# if exact name
# diff = difference in substitution ( max 10% )
# gapallowed *= %difference in substition
# - gapallowed *= # of intervening elements ( max 10 )
# - Consensus overlap is < 33 and the gap < gapallowed
if ( $intScore == 0 && &areLTRNamesCompat( $annot1, $annot2 ) == 1 ) {
print STDERR "scoreLTRPair(): last chance test ( names compat )\n"
if ( $DEBUG );
my $gapMax = 2500;
$gapMax *= 1.5 if ( $annot1->getHitName() eq $annot2->getHitName() );
# Need to revise the way div diff is calc'd
my $divDiff = $annot1->getPctSubst() - $annot2->getPctSubst();
$divDiff = -$divDiff if ( $divDiff < 0 );
$gapMax *= ( 10 - $divDiff ) / 10;
$gapMax *= ( 10 - $eleDistance ) / 10;
if (
$leftAnnot->getConsensusOverlap( $rightAnnot ) > -$gapMax
&& (
$hybrid
|| ( $leftAnnot->getConsensusOverlap( $rightAnnot ) < 33
&& $annot1->getLastField() == 5
&& $annot2->getLastField() == 5 )
)
)
{
print STDERR "scoreLTRPair(): Ok\n" if ( $DEBUG );
$intScore = 0.5;
}
elsif ( $DEBUG ) {
print STDERR "scoreLTRPair(): Not Ok: cg = "
. $leftAnnot->getConsensusGap( $rightAnnot ) . "\n";
print STDERR "scoreLTRPair(): co = "
. $leftAnnot->getConsensusOverlap( $rightAnnot )
. "< gapMax = -$gapMax or \n"
. " hybrid = $hybrid = 0 , co > 33\n";
print STDERR "scoreLTRPair(): or "
. $leftAnnot->getLastField() . " != "
. $rightAnnot->getLastField()
. " != 5\n";
}
}
## Last last chance from cycle 4
if ( $intScore == 0 ) {
print STDERR "scoreLTRPair(): last last chance test\n"
if ( $DEBUG );
if ( $leftAnnot->getSeq1End() >= $rightAnnot->getSeq1Beg()
&& $rightAnnot->getSeq1End() > $leftAnnot->getSeq1End() )
{
#
# If these element shave the same class, orientation,
# similar names with small overlap or simply just
# a large overlap then join them!!! Arghhh
#
if ( &areLTRNamesCompat( $annot1, $annot2 ) == 1
&& $rightAnnot->getSeq1Beg() <= $leftAnnot->getSeq1End() - 12
|| $rightAnnot->getSeq1Beg() <= $leftAnnot->getSeq1End() - 33 )
{
print STDERR "scoreLTRPair(): Well if you insist\n" if ( $DEBUG );
$intScore = 0.25;
}
}
}
}
elsif ( $DEBUG ) {
print STDERR "scoreLTRPair(): Names are not compatible\n";
}
if ( $intScore ) {
print STDERR "Using elementdistance = $eleDistance\n" if ( $DEBUG );
$intScore += 1 / $eleDistance;
}
print STDERR "scoreLTRPair(): Returning score = $intScore\n" if ( $DEBUG );
return $intScore;
} # scoreLTRPair()
sub isInternal {
my $annot = shift;
my $HitName = $annot->getHitName();
if (
( $HitName !~ /LTR/ || $HitName =~ /int$/ )
&& ( $HitName =~ /int|ERV|PRIMA41|Harlequin|HUERS/i
|| $HitName =~ /.*[-_]I(_\S+)?$/
|| $HitName =~ /MMERGLN|MMURS|MMVL30|MULV|MURVY|ETn|^IAP/ )
)
{
return ( 1 );
}
return ( 0 );
}
sub isLTR {
my $annot = shift;
return ( !&isInternal( $annot ) );
}
sub areLTRNamesCompat {
my $annot1 = shift;
my $annot2 = shift;
my $annot1Name = $annot1->getHitName();
my $annot1Class = $annot1->getClassName();
my $annot2Name = $annot2->getHitName();
my $annot2Class = $annot2->getClassName();
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "areLTRNamesCompat(): $annot1Name vs $annot2Name\n";
}
#
# Rules when annot1Name is internal
#
if ( $annot1Class eq $annot2Class ) {
my $shortHitName = $annot2Name;
if ( $annot2Name =~ /^MER\d{2}|^LTR\d{2}/ ) {
$shortHitName =~ s/(^\w{5}).*/$1/;
}
elsif ( $annot2Name =~ /^MER\d[A-Z_a-z]|^LTR\d[A-Z_a-z]|ORR1/ ) {
$shortHitName =~ s/(^\w{4}).*/$1/;
}
else {
$shortHitName =~ s/(\S+\d)[\-a-zA-Z].*/$1/;
}
$shortHitName = quotemeta $shortHitName;
print STDERR "areLTRNamesCompat(): comparing $annot1Name =~ $shortHitName\n"
if ( $DEBUG );
if ( $annot1Name =~ /$shortHitName/ ) {
print STDERR "areLTRNamesCompat(): returning 1\n" if ( $DEBUG );
return ( 1 );
}
if (
$annot1Class !~ /ERVL-MaLR/
&& $annot2Name !~ /pTR5/
# pTR5 is not a product of retrovrial transposition but
# appears like a "processed pseudogene". Obviously cant
# act like an LTR.
# The following are all MaLR names
|| ( $annot1Name =~ /^THE1/ && $annot2Name =~ /THE1|MST[AB-]/
|| $annot1Name =~ /^MST/ && $annot2Name =~ /THE1[BC-]|MST|MLT1[AB-]/
|| $annot1Name =~ /^MLT-int/
&& $annot2Name =~ /THE1C|MST[ABCD]|MLT1[ABC]/
|| $annot1Name =~ /^MLT1[A-]/ && $annot2Name =~ /MST[CD-]|MLT1[ABC-]/
|| $annot1Name =~ /^MLT1F/ && $annot2Name =~ /MLT1[DEFGHIJKL]/
|| $annot1Name =~ /MLT1[B-H]/ && $annot2Name =~ /MLT1/
|| $annot1Name =~ /^ORR1/ && $annot2Name =~ /^ORR1|^MT/
|| $annot1Name =~ /^MT/ && $annot2Name =~ /^MT|^ORR1/ )
)
{
print STDERR "areLTRNamesCompat(): returning 0.5\n" if ( $DEBUG );
return ( 0.5 );
}
if (
$annot2Class !~ /ERVL-MaLR/
|| ( $annot2Name =~ /^THE1/ && $annot1Name =~ /THE1|MST[AB-]/
|| $annot2Name =~ /^MST/ && $annot1Name =~ /THE1[BC-]|MST|MLT1[AB-]/
|| $annot2Name =~ /^MLT-int/
&& $annot1Name =~ /THE1C|MST[ABCD]|MLT1[ABC]/
|| $annot2Name =~ /^MLT1[A-]/ && $annot1Name =~ /MST[CD-]|MLT1[ABC-]/
|| $annot2Name =~ /^MLT1F/ && $annot1Name =~ /MLT1[DEFGHIJKL]/
|| $annot2Name =~ /MLT1[B-H]/ && $annot1Name =~ /MLT1/
|| $annot2Name =~ /^ORR1/ && $annot1Name =~ /^ORR1|^MT/
|| $annot2Name =~ /^MT/ && $annot1Name =~ /^MT|^ORR1/ )
)
{
print STDERR "areLTRNamesCompat(): returning 0.5\n" if ( $DEBUG );
return ( 0.5 );
}
}
# Not compat
if ( $DEBUG ) {
print STDERR "areLTRNamesCompat(): Not compatible!\n";
}
return ( 0 );
}
##########################################################################
##########################################################################
##########################################################################
##-------------------------------------------------------------------------##
## Use: my ( $seq_cnt, $totalSeqLen, $nonMaskedSeqLen, $totGCLevel,
## $totBPMasked ) =
## &maskSequence ( $seqDB, $annotationFile,
## $outputFile );
## Returns
##
## $seq_cnt: The number of sequences in the FASTA file.
## $totalSeqLen: The absoulte length of all sequences combined.
## $nonMaskedSeqLen: Length of sequence (excluding runs of >20 N's
## and X's) of the pre-masked sequence.
## $totGCLevel: The GC content of the original sequence.
## $totBPMasked: The total bp we masked
##
##-------------------------------------------------------------------------##
sub maskSequence {
my $maskFormat = shift;
my $seqDB = shift;
my $annotationFile = shift;
my $outputFile = shift;
print "ProcessRepeats::maskSequence()\n" if ( $DEBUG );
my %annots = ();
#
# Open up a search results object
#
my $searchResults =
CrossmatchSearchEngine::parseOutput( searchOutput => $annotationFile );
#
# Read in annotations and throw away the rest
#
my $prevResult;
for ( my $i = 0 ; $i < $searchResults->size() ; $i++ ) {
my $result = $searchResults->get( $i );
my $start = $result->getQueryStart();
my $end = $result->getQueryEnd();
if ( defined $prevResult
&& $prevResult->getQueryName() eq $result->getQueryName()
&& $prevResult->getQueryEnd() >= $start )
{
next if ( $prevResult->getQueryEnd() >= $end );
$start = $prevResult->getQueryEnd() + 1;
}
push @{ $annots{ $result->getQueryName() } },
{
'begin' => $start,
'end' => $end
};
$prevResult = $result;
}
undef $searchResults;
my @seqIDs = $seqDB->getIDs();
my $seq_cnt = scalar( @seqIDs );
my $sublength = $seqDB->getSubtLength();
my $totGCLevel = 100 * $seqDB->getGCLength() / $sublength;
$totGCLevel = sprintf "%4.2f", $totGCLevel;
my $totalSeqLen = 0;
my $totBPMasked = 0;
my $nonMaskedSeqLen = 0;
my $workseq = "";
open OUTFILE, ">$outputFile";
foreach my $seqID ( @seqIDs ) {
my $seq = $seqDB->getSequence( $seqID );
$totalSeqLen += length $seq;
$workseq = $seq;
$nonMaskedSeqLen += length $workseq;
# This was counting all N' rather than only ones in blocks of 20 or more
#$nonMaskedSeqLen -= ( $workseq =~ tr/[N,X]{20,}// );
while ( $workseq =~ /([X,N]{20,})/ig ) {
$nonMaskedSeqLen -= length( $1 );
}
foreach my $posRec ( @{ $annots{$seqID} } ) {
my $beginPos = $posRec->{'begin'};
my $endPos = $posRec->{'end'};
my $repLen = $endPos - $beginPos + 1;
substr( $workseq, $beginPos - 1, $repLen ) = "0" x ( $repLen );
if ( $maskFormat eq 'xsmall' ) {
substr( $seq, $beginPos - 1, $repLen ) =
lc( substr( $seq, $beginPos - 1, $repLen ) );
}
elsif ( $maskFormat eq 'x' ) {
substr( $seq, $beginPos - 1, $repLen ) = "X" x ( $repLen );
}
else {
substr( $seq, $beginPos - 1, $repLen ) = "N" x ( $repLen );
}
$totBPMasked += $repLen;
}
print OUTFILE ">" . $seqID;
my $desc = $seqDB->getDescription( $seqID );
if ( $desc ne "" ) {
print OUTFILE " " . $desc;
}
print OUTFILE "\n";
$seq =~ s/(\S{50})/$1\n/g;
$seq .= "\n"
unless ( $seq =~ /.*\n+$/s );
print OUTFILE $seq;
}
close OUTFILE;
return ( $seq_cnt, $totalSeqLen, $nonMaskedSeqLen, $totGCLevel,
$totBPMasked );
}
sub parseCATFile {
my %nameValuePairs = @_;
# Create ourselves as a hash
my $retObj = new ArrayList;
croak( "parseCATFile(): Missing 'file' parameter!\n" )
if ( !defined $nameValuePairs{'file'} );
open( XMATCH, $nameValuePairs{'file'} )
|| die "parseCATFile(): Cannot " . "open $nameValuePairs{'file'}\n";
my $id = -1;
my $matrixGCLevel = "";
my $matrixSubLevel = "";
my $alignData = "";
my $hit = undef;
while ( <XMATCH> ) {
if ( /^[^\#].+\(\d+\)/ ) { # only occurs in parse lines
if ( $hit && $alignData ) {
$hit->setAlignData( $alignData );
$alignData = "";
}
$hit = new Hit( $_ );
$id += 1;
$hit->setID( $id );
$hit->setMatrixSubLevel( $matrixSubLevel );
$hit->setMatrixGCLevel( $matrixGCLevel );
$retObj->add( $hit );
}
elsif ( $id >= 0 ) {
$alignData .= $_ unless ( defined $nameValuePairs{'noAlignData'} );
}
if ( /^Matrix =/ ) {
/(\d\d)p(\d\d)g.matrix/;
$matrixSubLevel = $1 if ( $1 );
$matrixGCLevel = $2 if ( $2 );
}
}
if ( $hit && $alignData ) {
$hit->setAlignData( $alignData );
$alignData = "";
}
close XMATCH;
return $retObj;
}
######################################################################
package Hit;
sub new {
my $class = shift; # @_ = (HIT, $parseLine)
my $parseLine = shift;
my $this = {};
bless $this, $class;
# create a reference for each parsed line, the line
# is parsed into a list of refs to hashes (LoH)
$this->addParsedLine( $parseLine );
return $this;
}
##-------------------------------------------------------------------------##
##
##=head2 clone()
##
## Use: my $newObj = $obj->clone();
##
## Clone a Hit *duplicating* all the values of the old
## object in the new one.
##
##=cut
##
##-------------------------------------------------------------------------##
sub clone {
my $this = shift;
my %newHash = %{$this};
my $newObj = \%newHash;
bless $newObj, ref( $this );
return $newObj;
}
# Just these fields for now
sub setFrom {
my $this = shift;
my $source = shift;
$this->setSW( $source->getSW() );
$this->setPctSubst( $source->getPctSubst() );
$this->setPctDelete( $source->getPctDelete() );
$this->setPctInsert( $source->getPctInsert() );
$this->setSeq1Name( $source->getSeq1Name() );
$this->setSeq1Beg( $source->getSeq1Beg() );
$this->setSeq1End( $source->getSeq1End() );
$this->setLeftOver( $source->getLeftOver() );
$this->setRevComp( $source->getRevComp() );
$this->setHitName( $source->getHitName() );
$this->setClassName( $source->getClassName() );
$this->setSeq2Beg( $source->getSeq2Beg() );
$this->setSeq2End( $source->getSeq2End() );
$this->set3PrimeUnaligned( $source->get3PrimeUnaligned() );
$this->setLastField( $source->getLastField() );
$this->setID( $source->getID() );
$this->setEquivHash( $source->getEquivHash() );
$this->setMatrixSubLevel( $source->getMatrixSubLevel() );
$this->setMatrixGCLevel( $source->getMatrixGCLevel() );
$this->setAlignData( $source->getAlignData() );
$this->setCATID( $source->getCATID() );
# WARNING: Do not inherit "derivedFromAnnots".
# These are the fields we are ignoring currently
# setScore
# setPctMatch
# setSeq1Len
# setSeq2Len
# setStatus
# setLeftLinkedHit
# setRightLinkedHit
return $this;
}
sub addParsedLine {
my ( $this, $line ) = @_;
#
# parse the line passed, the returned refs will correspond to
# the start and end of a hit, its name and orientation (rel to
# the first sequence in crossmatch. the next elements ([4] - [end])
# will contain the simscore (%match) and start and ending points)
#
$line =~ s/^\s+//;
my @tokens = split( /\s+/, $line );
$this->{'SW'} = $tokens[ 0 ]; # smith-waterman score
$this->{'SUBS'} = $tokens[ 1 ]; # % substitution (bidirectional)
# Flipped insertions and deletions to reflect nature and that seq2
# is the consensus/ancestor in RepeatMasker. Otherwise tricky to
# understand logic elsewhere in script.
$this->{'DEL'} = $tokens[ 2 ]; # % deletions seq1 vs seq2
$this->{'INS'} = $tokens[ 3 ]; # % insertions ""
$this->{'SEQ1NAME'} = $tokens[ 4 ]; # name of seq1
$this->{'SEQ1BEG'} = $tokens[ 5 ]; # beginning of alignment
$this->{'SEQ1END'} = $tokens[ 6 ]; # end of alignment
$this->{'SEQ1REMAINING'} = $tokens[ 7 ];
##
## TODO: Should do some fail early validation of the input...ie. sequence
## positions etc.
##
$this->{'MATCH'} = 100 - $this->{'SUBS'};
if ( $tokens[ 8 ] eq "C" ) { # the C for complemented seqs
$this->{'SEQ2NAME'} = $tokens[ 9 ]; # name of seq2
$this->{'REVCOMP'} = "C"; # to be added it to the array
$this->{'SEQ2REMAINING'} = $tokens[ 10 ]; # 3' unaligned portion
$this->{'SEQ2END'} = $tokens[ 11 ]; # end of seq2 alignment
$this->{'SEQ2BEG'} = $tokens[ 12 ]; # beginning of seq2 alignment
if ( defined $tokens[ 13 ] ) {
if ( $tokens[ 13 ] eq '*' ) {
if ( defined $tokens[ 14 ] ) {
$this->{'LASTFIELD'} = $tokens[ 14 ];
$this->{'CATID'} = $tokens[ 15 ];
}
else {
$this->{'LASTFIELD'} = 1; # -nocut option
}
}
else {
$this->{'LASTFIELD'} = $tokens[ 13 ];
$this->{'CATID'} = $tokens[ 14 ];
}
}
else {
$this->{'LASTFIELD'} = 1; # -nocut option
}
}
elsif ( $tokens[ 8 ] eq '+' ) { # for cycles 1-4
$this->{'SEQ2NAME'} = $tokens[ 9 ];
$this->{'REVCOMP'} = '+';
$this->{'SEQ2BEG'} = $tokens[ 10 ];
$this->{'SEQ2END'} = $tokens[ 11 ]; #
$this->{'SEQ2REMAINING'} = $tokens[ 12 ];
if ( $tokens[ 13 ] eq '*' ) {
$this->{'LASTFIELD'} = $tokens[ 14 ];
$this->{'CATID'} = $tokens[ 15 ];
}
else {
$this->{'LASTFIELD'} = $tokens[ 13 ];
$this->{'CATID'} = $tokens[ 14 ];
}
}
else {
$this->{'REVCOMP'} = '+';
$this->{'SEQ2NAME'} = $tokens[ 8 ];
$this->{'SEQ2BEG'} = $tokens[ 9 ];
$this->{'SEQ2END'} = $tokens[ 10 ];
$this->{'SEQ2REMAINING'} = $tokens[ 11 ];
if ( defined $tokens[ 12 ] ) {
if ( $tokens[ 12 ] eq '*' ) {
if ( defined $tokens[ 13 ] ) {
$this->{'LASTFIELD'} = $tokens[ 13 ];
$this->{'CATID'} = $tokens[ 14 ];
}
else {
$this->{'LASTFIELD'} = 1;
}
}
else {
$this->{'LASTFIELD'} = $tokens[ 12 ];
$this->{'CATID'} = $tokens[ 13 ];
}
}
else {
$this->{'LASTFIELD'} = 1;
}
}
# we will return an array with the beginning and end positions
# of the hit, its name, and its orientation
$this->{'SEQ1REMAINING'} =~ tr/[()]//d; # remove flanking "()"
$this->{'SEQ2REMAINING'} =~ tr/[()]//d; # remove flanking "()"
$this->setClassName( "Unknown" )
unless ( $this->getClassName() );
}
# the following methods are used to get the data
sub getMatrixSubLevel {
my $this = shift;
return $this->{'MATRIXSUB'};
}
sub setMatrixSubLevel {
my $this = shift;
$this->{'MATRIXSUB'} = shift;
}
sub getMatrixGCLevel {
my $this = shift;
return $this->{'MATRIXGC'};
}
sub setMatrixGCLevel {
my $this = shift;
$this->{'MATRIXGC'} = shift;
}
# smith-waterman score
sub getSW {
my $this = shift;
return $this->{'SW'};
}
sub setSW {
my $this = shift;
$this->{'SW'} = shift;
}
sub getAlignData {
my $this = shift;
return $this->{'ALIGNDATA'};
}
sub setAlignData {
my $this = shift;
$this->{'ALIGNDATA'} = shift;
}
sub getScore {
my $this = shift;
return $this->{'SW'};
}
sub setScore {
my $this = shift;
$this->{'SW'} = shift;
}
# % substitution (seq1 vs seq2)
sub getPctSubst {
my $this = shift;
return $this->{'SUBS'};
}
sub setPctSubst {
my $this = shift;
$this->{'SUBS'} = shift;
}
# leftover sequence of query
sub getLeftOver {
my $this = shift;
return $this->{'SEQ1REMAINING'};
}
sub setLeftOver {
my $this = shift;
$this->{'SEQ1REMAINING'} = shift;
}
# percent match
sub getPctMatch {
my $this = shift;
return $this->{'MATCH'};
}
sub setPctMatch {
my $this = shift;
$this->{'MATCH'} = shift;
}
## Flipped insertions and deletions to reflect RepeatMasker standard:
## deletions and insertions should be with respect to the consensus
## (ancestral) sequences (seq2 in RepeatMasker)
# % deletions
sub getPctDelete {
my $this = shift;
return $this->{'DEL'};
}
sub setPctDelete {
my $this = shift;
$this->{'DEL'} = shift;
}
# % insertions
sub getPctInsert {
my $this = shift;
return $this->{'INS'};
}
sub setPctInsert {
my $this = shift;
$this->{'INS'} = shift;
}
# name of sequence 1
sub getSeq1Name {
my $this = shift;
return $this->{'SEQ1NAME'};
}
sub setSeq1Name {
my $this = shift;
$this->{'SEQ1NAME'} = shift;
}
# beginning of alignment
sub getSeq1Beg {
my $this = shift;
return $this->{'SEQ1BEG'};
}
sub setSeq1Beg {
my $this = shift;
$this->{'SEQ1BEG'} = shift;
}
# end of alignment
sub getSeq1End {
my $this = shift;
return $this->{'SEQ1END'};
}
sub setSeq1End {
my $this = shift;
$this->{'SEQ1END'} = shift;
}
#len of seq1
sub getSeq1Len {
my $this = shift;
return $this->{'SEQ1LEN'};
}
sub setSeq1Len {
my $this = shift;
$this->{'SEQ1LEN'} = shift;
}
# name of hit (tokens[9])
sub getSeq2Name {
my $this = shift;
return $this->{'SEQ2NAME'};
}
sub setSeq2Name {
my $this = shift;
$this->{'SEQ2NAME'} = shift;
}
# returns the orientation of the hit
sub getRevComp {
my $this = shift;
return $this->{'REVCOMP'};
}
sub setRevComp {
my $this = shift;
$this->{'REVCOMP'} = shift;
}
# returns beginning of seq 2 alignment
sub getSeq2Beg {
my $this = shift;
return $this->{'SEQ2BEG'};
}
sub setSeq2Beg {
my $this = shift;
$this->{'SEQ2BEG'} = shift;
}
# returns end of seq 2 alignment
sub getSeq2End {
my $this = shift;
return $this->{'SEQ2END'};
}
sub setSeq2End {
my $this = shift;
$this->{'SEQ2END'} = shift;
}
# returns length of 3' unaligned portion
sub get3PrimeUnaligned {
my $this = shift;
return $this->{'SEQ2REMAINING'};
}
sub set3PrimeUnaligned {
my $this = shift;
$this->{'SEQ2REMAINING'} = shift;
}
# returns the length of Seq2
sub getSeq2Len {
my $this = shift;
#if ( ! defined $this->{'SEQ2LEN'} || $this->{'SEQ2LEN'} !~ /[\d-\.]+/ )
#{
$this->{'SEQ2LEN'} =
$this->{'SEQ2END'} + $this->{'SEQ2REMAINING'}; # for "dotplots"
#}
return $this->{'SEQ2LEN'};
}
# NOTE: THIS ISN'T USED....
sub setSeq2Len {
my $this = shift;
$this->{'SEQ2LEN'} = shift;
}
# returns the length of Seq2
sub getEquivHash {
my $this = shift;
return $this->{'EQUIVHASH'};
}
sub setEquivHash {
my $this = shift;
$this->{'EQUIVHASH'} = shift;
}
#returns level of condensation of DNA
sub getLastField {
my $this = shift;
return $this->{'LASTFIELD'};
}
sub setLastField {
my $this = shift;
$this->{'LASTFIELD'} = shift;
}
#returns line ID number
sub getID {
my $this = shift;
return $this->{'LINEID'};
}
sub setID {
my $this = shift;
$this->{'LINEID'} = shift;
}
# The ID used in the cat file
sub setCATID {
my $this = shift;
$this->{'CATID'} = shift;
}
sub getCATID {
my $this = shift;
return $this->{'CATID'};
}
#returns status ( currently only used for DNA transposon analysis )
sub getStatus {
my $this = shift;
return $this->{'STATUS'};
}
sub setStatus {
my $this = shift;
$this->{'STATUS'} = shift;
}
sub getBlockLeftJoin {
my $this = shift;
return $this->{'BLOCKLEFTJOIN'};
}
sub setBlockLeftJoin {
my $this = shift;
$this->{'BLOCKLEFTJOIN'} = shift;
}
sub getBlockRightJoin {
my $this = shift;
return $this->{'BLOCKRIGHTJOIN'};
}
sub setBlockRightJoin {
my $this = shift;
$this->{'BLOCKRIGHTJOIN'} = shift;
}
sub getRMAlignQueryLen {
my $this = shift;
return $this->{'RMALIGNQUERYLEN'};
}
sub setRMAlignQueryLen {
my $this = shift;
$this->{'RMALIGNQUERYLEN'} = shift;
}
#returns element ( if set ) who is linked to our left edge ( Seq1Begin )
#
sub getLeftLinkedHit {
my $this = shift;
return $this->{'LEFTHIT'};
}
sub setLeftLinkedHit {
my $this = shift;
$this->{'LEFTHIT'} = shift;
}
#returns element ( if set ) who is linked to our right edge ( Seq1End )
#
sub getRightLinkedHit {
my $this = shift;
return $this->{'RIGHTHIT'};
}
sub setRightLinkedHit {
my $this = shift;
$this->{'RIGHTHIT'} = shift;
}
sub getClassName {
my $this = shift;
my ( $hitName, $className ) =
split( /\#/, $this->{'SEQ2NAME'} );
return $className;
}
sub setClassName {
my $this = shift;
my $newClassName = shift;
my ( $hitName, $className ) =
split( /\#/, $this->{'SEQ2NAME'} );
$this->{'SEQ2NAME'} = $hitName . "#" . $newClassName;
}
sub getHitName {
my $this = shift;
my ( $hitName, $className ) =
split( /\#/, $this->{'SEQ2NAME'} );
return $hitName;
}
sub setHitName {
my $this = shift;
my $newHitName = shift;
my ( $hitName, $className ) =
split( /\#/, $this->{'SEQ2NAME'} );
$this->{'SEQ2NAME'} = $newHitName . "#" . $className;
}
sub getUniqID {
my $this = shift;
return ( $this->{'SW'}
. $this->{'SUBS'}
. $this->{'DEL'}
. $this->{'INS'}
. $this->{'SEQ1NAME'}
. $this->{'SEQ1BEG'}
. $this->{'SEQ1END'}
. $this->{'SEQ1REMAINING'}
. $this->{'REVCOMP'}
. $this->{'SEQ2NAME'}
. $this->{'SEQ2BEG'}
. $this->{'SEQ2END'}
. $this->{'SEQ2REMAINING'} );
}
sub getDerivedFromAnnot {
my $this = shift;
return ( $this->{'DERIVEDFROM'} );
}
sub setDerivedFromAnnot {
my $this = shift;
my $member = shift;
my $annot = new Hit;
$annot->setFrom( $member );
$this->{'DERIVEDFROM'} = [ $member ];
}
sub addDerivedFromAnnot {
my $this = shift;
my $member = shift;
#print STDERR "Pushing DERIVED\n";
my $annot = new Hit;
$annot->setFrom( $member );
## This needs to be a deep copy
if ( $member->getDerivedFromAnnot() ) {
foreach my $subAnnot ( @{ $member->getDerivedFromAnnot() } ) {
$annot->addDerivedFromAnnot( $subAnnot );
}
}
push @{ $this->{'DERIVEDFROM'} }, $annot;
}
sub print {
my $this = shift;
my $noLineTerm = shift;
my $lineTerm = "\n" if ( !defined $noLineTerm );
my $outStr = sprintf(
"%4d %3.1f %3.1f %3.1f %-18.18s %8d %8d "
. "%8d %1s %-18.18s %8d %8d %8d %3d %3d %6s %6s$lineTerm",
$this->{'SW'}, $this->{'SUBS'},
$this->{'DEL'}, $this->{'INS'},
$this->{'SEQ1NAME'}, $this->{'SEQ1BEG'},
$this->{'SEQ1END'}, $this->{'SEQ1REMAINING'},
$this->{'REVCOMP'}, $this->{'SEQ2NAME'},
$this->{'SEQ2BEG'}, $this->{'SEQ2END'},
$this->{'SEQ2REMAINING'}, $this->{'LASTFIELD'},
$this->{'LINEID'}, $this->{'CATID'},
$this->{'STATUS'}
);
print STDERR $outStr;
}
sub printBrief {
my $this = shift;
my $outStr = sprintf(
"%4d %-18.18s %8d %8d " . "%1s %-18.18s %8d %8d\n",
$this->{'SW'}, $this->{'SEQ1NAME'},
$this->{'SEQ1BEG'}, $this->{'SEQ1END'},
$this->{'REVCOMP'}, $this->{'SEQ2NAME'},
$this->{'SEQ2BEG'}, $this->{'SEQ2END'}
);
print STDERR $outStr;
}
sub printLeftRightLinks {
my $this = shift;
if ( $this->getLeftLinkedHit() != undef ) {
if ( $this->getLeftLinkedHit() == $this ) {
print STDERR " BLOCKED ( links to self )\n";
}
else {
print STDERR " ";
$this->getLeftLinkedHit()->printBrief();
}
}
else {
print STDERR " UNDEF\n";
}
print STDERR " -->";
$this->printBrief();
if ( $this->getRightLinkedHit() != undef ) {
if ( $this->getRightLinkedHit() == $this ) {
print STDERR " BLOCKED ( links to self )\n";
}
else {
print STDERR " ";
$this->getRightLinkedHit()->printBrief();
}
}
else {
print STDERR " UNDEF\n";
}
}
sub sanityCheckConsPos {
my $this = shift;
my $hashRef = shift;
# Find begining
print STDERR "Sanity Checking:\n";
my $firstInChain = $this;
my $detectLoop = 0;
while ( $firstInChain->getLeftLinkedHit() != undef
&& $detectLoop < 50 )
{
# Ok to link to self.
if ( $firstInChain == $firstInChain->getLeftLinkedHit() ) {
last;
}
$firstInChain = $firstInChain->getLeftLinkedHit();
$detectLoop++;
}
if ( $detectLoop >= 50 ) {
print STDERR "WARNING! This chain contains a loop!!!!\n";
}
# Now print
my $nextInChain = $firstInChain;
do {
if ( $nextInChain == $this ) {
print STDERR "--> (";
}
else {
print STDERR " (";
}
print STDERR "" . $hashRef->{ $nextInChain->getID() } . "): ";
$nextInChain->printBrief();
# Link to itself is also allowed
if ( $nextInChain == $nextInChain->getRightLinkedHit() ) {
last;
}
$nextInChain = $nextInChain->getRightLinkedHit();
} while ( $nextInChain )
}
#
# Print an element and ( if exists ) all of it chain members in order
#
sub printLinks {
my $this = shift;
# Find begining
my $firstInChain = $this;
my $detectLoop = 0;
while ( $firstInChain->getLeftLinkedHit() != undef
&& $firstInChain != $firstInChain->getLeftLinkedHit()
&& $detectLoop < 50 )
{
$firstInChain = $firstInChain->getLeftLinkedHit();
$detectLoop++;
}
if ( $detectLoop >= 50 ) {
print STDERR "WARNING! This chain contains a loop!!!!\n";
}
# Now print
my $nextInChain = $firstInChain;
do {
if ( $nextInChain == $this ) {
print STDERR "--> ";
}
else {
print STDERR " ";
}
$nextInChain->printBrief();
# Link to itself is also allowed
if ( $nextInChain == $nextInChain->getRightLinkedHit() ) {
last;
}
$nextInChain = $nextInChain->getRightLinkedHit();
} while ( $nextInChain )
}
# Intelligently relink an element's edges prior to removal
sub removeFromJoins {
my $this = shift;
my $DEBUG = 0;
my $left = $this->getLeftLinkedHit();
my $right = $this->getRightLinkedHit();
if ( $DEBUG ) {
print STDERR "Remove from joins:\n";
$this->printLinks();
}
# Just reset these since we are being removed
$this->setLeftLinkedHit( undef )
unless ( $this == $left ); # don't removedlinks to itself.
$this->setRightLinkedHit( undef )
unless ( $this == $right ); # don't remove links to itself.
$left = undef if ( $this == $left );
$right = undef if ( $this == $right );
if ( defined $left && !defined $right ) {
# Remove left's edge reference
$left->setRightLinkedHit( undef );
}
elsif ( defined $left && defined $right ) {
# Join our neighbors together
$left->setRightLinkedHit( $right );
$right->setLeftLinkedHit( $left );
}
elsif ( !defined $left && defined $right ) {
# Remove rights's edge reference
$right->setLeftLinkedHit( undef );
}
}
# Intelligently relink an elements edges for insertion
sub join {
my $this = shift;
my $partner = shift;
if ( $DEBUG ) {
print STDERR "join this:\n";
$this->printLinks();
print STDERR "to partner\n";
$partner->printLinks();
}
die "join(): Invalid join! \$this == \$partner" if ( $this == $partner );
my @cluster = ();
foreach my $chain ( $this, $partner ) {
push @cluster, $chain;
my $nextInChain = $chain;
while ( $nextInChain->getLeftLinkedHit()
&& $nextInChain->getLeftLinkedHit() != $nextInChain )
{
$nextInChain = $nextInChain->getLeftLinkedHit();
push @cluster, $nextInChain;
}
$nextInChain = $chain;
while ( $nextInChain->getRightLinkedHit()
&& $nextInChain->getRightLinkedHit() != $nextInChain )
{
$nextInChain = $nextInChain->getRightLinkedHit();
push @cluster, $nextInChain;
}
}
# Sort cluster
@cluster = sort { $a->comparePositionOrder( $b ) } ( @cluster );
my $lastAnnot = undef;
foreach my $annot ( @cluster ) {
next if ( $annot == $lastAnnot );
$annot->setLeftLinkedHit( $lastAnnot );
$annot->setRightLinkedHit( undef );
if ( $lastAnnot ) {
$lastAnnot->setRightLinkedHit( $annot );
}
$lastAnnot = $annot;
}
if ( $DEBUG ) {
print STDERR "Now look what we did with this thing:\n";
$this->printLinks();
}
}
# Intelligently relink an elements edges for insertion
sub resortJoins {
my $this = shift;
my @cluster = ();
push @cluster, $this;
my $nextInChain = $this;
while ( $nextInChain->getLeftLinkedHit()
&& $nextInChain->getLeftLinkedHit() != $nextInChain )
{
$nextInChain = $nextInChain->getLeftLinkedHit();
push @cluster, $nextInChain;
}
$nextInChain = $this;
while ( $nextInChain->getRightLinkedHit()
&& $nextInChain->getRightLinkedHit() != $nextInChain )
{
$nextInChain = $nextInChain->getRightLinkedHit();
push @cluster, $nextInChain;
}
# Sort cluster
@cluster = sort { $a->comparePositionOrder( $b ) } ( @cluster );
my $lastAnnot = undef;
foreach my $annot ( @cluster ) {
next if ( $annot == $lastAnnot );
$annot->setLeftLinkedHit( $lastAnnot );
$annot->setRightLinkedHit( undef );
if ( $lastAnnot ) {
$lastAnnot->setRightLinkedHit( $annot );
}
$lastAnnot = $annot;
}
if ( $DEBUG ) {
print STDERR "Now look what we did with this thing:\n";
$this->printLinks();
}
}
# Intelligently merge $partner information with us. Then remove
# our partner's links to ready it for removal.
sub mergeSimpleLow {
my $this = shift;
my $partner = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "mergeSimpleLow(): THIS links:\n";
$this->printLinks();
print STDERR "mergeSimpleLow(): PARTNER links\n";
$partner->printLinks();
}
# Pick appropriate substitution/insertion/deletion stats for
# merged element.
if ( $this->getHitName() eq $partner->getHitName() ) {
$this->adjustSubstLevel( $partner, "noQueryOverlapAdj" );
$this->setSW( $partner->getSW() )
if ( $this->getSW() < $partner->getSW() );
}
else {
if ( $this->getSW() < $partner->getSW() ) {
$this->setPctSubst( $partner->getPctSubst() );
$this->setPctDelete( $partner->getPctDelete() );
$this->setPctInsert( $partner->getPctInsert() );
$this->setSW( $partner->getSW() );
$this->setSeq2Name( $partner->getSeq2Name() );
} # else....keep ours
}
# Pick the lower query begin position
$this->setSeq1Beg( $partner->getSeq1Beg() )
if ( $this->getSeq1Beg() > $partner->getSeq1Beg() );
# Pick the higher query end position
if ( $this->getSeq1End() < $partner->getSeq1End() ) {
$this->setSeq1End( $partner->getSeq1End() );
$this->setLeftOver( $partner->getLeftOver() );
}
my $newQuerySize = $this->getSeq1End() - $this->getSeq1Beg() + 1;
my $newSeq2End =
$newQuerySize + ( $this->getPctDelete() - $this->getPctInsert() ) *
$newQuerySize / 100;
$this->setSeq2Beg( 1 );
$this->setSeq2End( sprintf( "%d", $newSeq2End ) );
## TODO: What happens when our partner has joins that
## should point to the new merger?
$partner->removeFromJoins();
if ( $DEBUG ) {
print STDERR "mergeSimpleLow(): Final THIS links:\n";
$this->printLinks();
print STDERR "mergeSimpleLow(): Leaving\n";
}
}
# Intelligently merge $partner information with us. Then remove
# our partner's links to ready it for removal.
sub merge {
my $this = shift;
my $partner = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "merge(): Entered\n";
print STDERR "merge(): THIS links:\n";
$this->printLinks();
print STDERR "merge(): PARTNER links\n";
$partner->printLinks();
}
# Pick appropriate substitution/insertion/deletion stats for
# merged element.
$this->adjustSubstLevel( $partner );
# Pick the lower query begin position
$this->setSeq1Beg( $partner->getSeq1Beg() )
if ( $this->getSeq1Beg() > $partner->getSeq1Beg() );
# Pick the higher query end position
if ( $this->getSeq1End() < $partner->getSeq1End() ) {
$this->setSeq1End( $partner->getSeq1End() );
$this->setLeftOver( $partner->getLeftOver() );
}
# Find the lower consensus begin position
my $minBeg = $partner->getSeq2Beg();
$minBeg = $this->getSeq2Beg()
if ( $this->getSeq2Beg() < $minBeg );
# Find the higher consensus end position
my $maxEnd = $partner->getSeq2End();
$maxEnd = $this->getSeq2End()
if ( $this->getSeq2End() > $maxEnd );
# Sanity check consensus position choices. If
# the hybrid range ( lowest begin & highest end ) of
# the two elements is > 2* query length then
# use the original range of the higher scoring
# element instead of the hybrid.
if ( ( $maxEnd - $minBeg + 1 ) >
( 2 * ( $this->getSeq1End() - $this->getSeq1Beg() + 1 ) ) )
{
# Use the highest scoring annotation's range
if ( $this->getSW() < $partner->getSW() ) {
$this->setSeq2Beg( $partner->getSeq2Beg() );
$this->setSeq2End( $partner->getSeq2End() );
$this->set3PrimeUnaligned( $partner->get3PrimeUnaligned() );
}
}
else {
# Use a hybrid range
$this->setSeq2Beg( $minBeg );
if ( $this->getSeq2End() < $partner->getSeq2End() ) {
$this->setSeq2End( $maxEnd );
$this->set3PrimeUnaligned( $partner->get3PrimeUnaligned() );
}
}
# Use the higher score and it's associated consensus name
if ( $this->getSW() < $partner->getSW() ) {
$this->setSW( $partner->getSW() );
$this->setSeq2Name( $partner->getSeq2Name() );
}
$partner->removeFromJoins();
if ( $DEBUG ) {
print STDERR "merge(): Final THIS links:\n";
$this->printLinks();
print STDERR "merge(): Leaving\n";
}
}
#### NEW TESTING
sub getAdjustedSubstLevel {
my $this = shift;
my $partner = shift;
my $method = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR
"getAdjustedSubstLevel( this, partner, method = $method ): Entered\n";
print STDERR "this: ";
$this->print();
print STDERR "partner: ";
$partner->print();
}
warn "getAdjustedSubstLevel(): Unknown method $method"
if ( defined $method && $method !~ /noQueryOverlapAdj/ );
# For calculation, choose best matching consensus in overlapped region
my $subBases;
my $delBases;
my $insBases;
#
# This change allows us to calculate these stats based on
# the complete alignemnt returned by RM. Previously this would
# only account for one fragment.
# TODO: Allow this change after a sanity check!
#
my $thisLength = $this->getSeq1End() - $this->getSeq1Beg() + 1;
#my $thisLength = $this->getRMAlignQueryLen();
my $partnerLength = $partner->getSeq1End() - $partner->getSeq1Beg() + 1;
#my $partnerLength = $partner->getRMAlignQueryLen();
my $qo = 0;
$qo = $this->getQueryOverlap( $partner )
unless ( $method eq "noQueryOverlapAdj" );
my $co = $this->getConsensusOverlap( $partner );
print STDERR "adjustSubstLevel(): qo = $qo, co = $co, "
. "thisLength = $thisLength, "
. "partnerLength = $partnerLength\n"
if ( $DEBUG );
if ( $this->getPctSubst() <= $partner->getPctSubst() ) {
$subBases = $thisLength * $this->getPctSubst() + ( $partnerLength - $qo ) *
$partner->getPctSubst();
$delBases = $thisLength * $this->getPctDelete() + ( $partnerLength - $qo ) *
$partner->getPctDelete();
$insBases = $thisLength * $this->getPctInsert() + ( $partnerLength - $qo ) *
$partner->getPctInsert();
}
else {
$subBases =
$partnerLength * $partner->getPctSubst() + ( $thisLength - $qo ) *
$this->getPctSubst();
$delBases =
$partnerLength * $partner->getPctDelete() + ( $thisLength - $qo ) *
$this->getPctDelete();
$insBases =
$partnerLength * $partner->getPctInsert() + ( $thisLength - $qo ) *
$this->getPctInsert();
}
# Include the query or consensus gap in $PctInsert or $PctDelete
# Expressed in percent (not bases)
if ( $qo <= 10 && $method ne "noQueryOverlapAdj" ) {
if ( $co - $qo > 0 ) {
$insBases += ( $co - $qo ) * 100;
}
else {
$delBases -= ( $co - $qo ) * 100;
}
}
my $totalLength = $thisLength + $partnerLength - $qo;
$totalLength = 1 if $totalLength < 1;
print STDERR "getAdjustedSubstLevel(): subBases="
. ( $subBases / 100 )
. ", delBases="
. ( $delBases / 100 )
. ", insBases= "
. ( $insBases / 100 )
. ", totalLength = $totalLength\n"
if ( $DEBUG );
return (
( $subBases / 100 ),
sprintf( "%0.2f", ( $subBases / $totalLength ) ),
( $delBases / 100 ),
sprintf( "%0.2f", ( $delBases / $totalLength ) ),
( $insBases / 100 ),
sprintf( "%0.2f", ( $insBases / $totalLength ) )
);
}
# Adjust the current element's divergence characteristics based
# on the overlap between it and a past element ( j ). If $ignorediv
# is set simply set the current to the past element -- note this
# is possibly not needed anymore.
sub adjustSubstLevel {
my $this = shift;
my $partner = shift;
my $method = shift;
my $DEBUG = 0;
if ( $DEBUG ) {
print STDERR "adjustSubstLevel( $this, $partner, $method ): Entered\n";
$this->print();
$partner->print();
}
warn "adjustSubstLevel(): Unknown method $method"
if ( defined $method && $method !~ /noQueryOverlapAdj/ );
my ( $subBases, $subPct, $delBases, $delPct, $insBases, $insPct ) =
getAdjustedSubstLevel( $this, $partner, $method );
$this->setPctSubst( $subPct );
$this->setPctDelete( $delPct );
$this->setPctInsert( $insPct );
}
sub comparePositionOrder {
my $this = shift;
my $refElement = shift;
# Am I on the left or right of the reference?
return ( $this->getSeq1Name() ) cmp( $refElement->getSeq1Name() )
|| ( $this->getSeq1Beg() ) <=> ( $refElement->getSeq1Beg() )
|| ( $refElement->getSeq1End() ) <=> ( $this->getSeq1End() )
|| ( $refElement->getSW() ) <=> ( $this->getSW() );
}
#
# Tests if this current element is joined
# so that it "contains" the refElement.
#
#
# +-------------------------------------+
# | |
# ------- .. --refElement--- .. ---this----
#
# or
#
# +-------------------------------------+
# | |
# --this--- .. --refElement--- .. --------
#
sub containsElement {
my $this = shift;
my $refElement = shift;
# Am I on the left or right of the reference?
if ( $this->comparePositionOrder( $refElement ) > 0 ) {
# I am on the right
my $leftLink = $this->getLeftLinkedHit();
return 0 if ( $leftLink == undef || $leftLink == $this );
return 1 if ( $leftLink->comparePositionOrder( $refElement ) < 0 );
}
else {
# I am on the left
my $rightLink = $this->getRightLinkedHit();
return 0 if ( $rightLink == undef || $rightLink == $this );
return 1 if ( $rightLink->comparePositionOrder( $refElement ) > 0 );
}
}
sub getConsensusGap {
my $this = shift;
my $partner = shift;
return ( -$this->getConsensusOverlap( $partner ) );
}
sub getConsensusOverlap {
my $this = shift;
my $partner = shift;
warn "getConsensusOverlap() mismatched orientations!\n"
if ( $this->getRevComp() != $partner->getRevComp() );
my $left = $this;
my $right = $partner;
if ( $left->comparePositionOrder( $right ) > 0 ) {
# I am on the right
$left = $partner;
$right = $this;
}
if ( $this->getRevComp() eq "C" ) {
# 0
# <--left--, <--right---
#
return ( $right->getSeq2End() - $left->getSeq2Beg() + 1 );
}
else {
# 0
# --left-->, --right-->
#
return ( $left->getSeq2End() - $right->getSeq2Beg() + 1 );
}
}
sub getQueryGap {
my $this = shift;
my $partner = shift;
return ( -$this->getQueryOverlap( $partner ) );
}
sub getQueryOverlap {
my $this = shift;
my $partner = shift;
my $sign = 1;
$sign = -1
if ( $this->getSeq1Beg() > $partner->getSeq1End()
|| $partner->getSeq1Beg > $this->getSeq1End() );
my $left = $this->getSeq1Beg();
$left = $partner->getSeq1Beg()
if ( $partner->getSeq1Beg() > $left );
my $right = $this->getSeq1End();
$right = $partner->getSeq1End()
if ( $partner->getSeq1End() < $right );
return ( abs( $right - $left + 1 ) * $sign );
}
sub getChainConsensusExtents {
my $this = shift;
my $seq2Beg = $this->getSeq2Beg();
my $seq2End = $this->getSeq2End();
my $nextInChain = $this;
while ( $nextInChain = $nextInChain->getRightLinkedHit() ) {
$seq2Beg = $nextInChain->getSeq2Beg()
if ( $seq2Beg > $nextInChain->getSeq2Beg() );
}
my $nextInChain = $this;
while ( $nextInChain = $nextInChain->getRightLinkedHit() ) {
$seq2End = $nextInChain->getSeq2End()
if ( $seq2End < $nextInChain->getSeq2End() );
}
return ( $seq2Beg, $seq2End );
}
package main;