3 Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
4 Copyright [2016-2024] EMBL-European Bioinformatics Institute
6 Licensed under the Apache License, Version 2.0 (the
"License");
7 you may not use
this file except in compliance with the License.
8 You may obtain a copy of the License at
12 Unless required by applicable law or agreed to in writing, software
13 distributed under the License is distributed on an
"AS IS" BASIS,
14 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 See the License
for the specific language governing permissions and
16 limitations under the License.
23 Please email comments or questions to the
public Ensembl
24 developers list at <http:
26 Questions may also be sent to the Ensembl help desk at
37 #To convert between coordinates:
40 my $gen_coord = $pair->cDNA2genomic($cdna_coord);
44 Contains list of sub alignments making up a dna-dna alignment
60 Any number of pair alignments can be added to the
PairAlign object
64 package Bio::EnsEMBL::Analysis::PairAlign;
71 my($class,@args) = @_;
75 $self->{
'_homol'} = [];
77 return $self; # success - we hope!
81 my ($self,$pair) = @_;
83 $self->throw(
"Not a Bio::EnsEMBL::FeaturePair object") unless ($pair->isa(
"Bio::EnsEMBL::FeaturePair"));
85 push(@{$self->{
'_pairs'}},$pair);
90 =head2 eachFeaturePair
92 Title : eachFeaturePair
93 Example : my @pairs = $pair->eachFeaturePair
94 Returns : Array of Bio::SeqFeature::FeaturePair
101 if (defined($self->{
'_pairs'})) {
102 return @{$self->{
'_pairs'}};
109 my @features = $self->eachFeaturePair;
111 return $features[0]->hstrand;
117 Usage : my $cdna_coord = $pair->genomic2cDNA($gen_coord)
118 Function: Converts a genomic coordinate to a cdna coordinate
124 my ($self,$coord) = @_;
125 my @pairs = $self->eachFeaturePair;
127 @pairs = sort {$a->start <=> $b->start} @pairs;
131 HOMOL:
while (my $sf1 = shift(@pairs)) {
132 next HOMOL unless ($coord >= $sf1->start && $coord <= $sf1->end);
134 if ($sf1->strand == 1 && $sf1->hstrand == 1) {
135 $newcoord = $sf1->hstart + ($coord - $sf1->start);
137 } elsif ($sf1->strand == 1 && $sf1->hstrand == -1) {
138 $newcoord = $sf1->hend - ($coord - $sf1->start);
140 } elsif ($sf1->strand == -1 && $sf1->hstrand == 1) {
141 $newcoord = $sf1->hstart + ($sf1->end - $coord);
143 } elsif ($sf1->strand == -1 && $sf1->hstrand == -1) {
144 $newcoord = $sf1->hend - ($sf1->end - $coord);
147 $self->throw(
"ERROR: Wrong strand value in FeaturePair (" . $sf1->strand .
"/" . $sf1->hstrand .
"\n");
151 if (defined($newcoord)) {
155 $self->throw(
"Couldn't convert $coord");
162 Usage : my $gen_coord = $pair->genomic2cDNA($cdna_coord)
163 Function: Converts a cdna coordinate to a genomic coordinate
172 my ($self,$coord) = @_;
174 my @pairs = $self->eachFeaturePair;
178 HOMOL:
while (my $sf1 = shift(@pairs)) {
179 next HOMOL unless ($coord >= $sf1->hstart && $coord <= $sf1->hend);
181 if ($sf1->strand == 1 && $sf1->hstrand == 1) {
182 $newcoord = $sf1->start + ($coord - $sf1->hstart);
184 } elsif ($sf1->strand == 1 && $sf1->hstrand == -1) {
185 $newcoord = $sf1->start +($sf1->hend - $coord);
187 } elsif ($sf1->strand == -1 && $sf1->hstrand == 1) {
188 $newcoord = $sf1->end - ($coord - $sf1->hstart);
190 } elsif ($sf1->strand == -1 && $sf1->hstrand == -1) {
191 $newcoord = $sf1->end - ($sf1->hend - $coord);
194 $self->throw(
"ERROR: Wrong strand value in homol (" . $sf1->strand .
"/" . $sf1->hstrand .
"\n");
198 if (defined ($newcoord)) {
201 $self->throw(
"Couldn't convert $coord\n");
206 my ($self,$coord) = @_;
208 foreach my $p ($self->eachFeaturePair) {
209 if ($coord >= $p->hstart && $coord <= $p->hend) {
215 =head2 convert_cDNA_feature
217 Title : convert_cDNA_feature
218 Usage : my @newfeatures = $self->convert_cDNA_feature($f);
219 Function: Converts a feature on the cDNA into an array of
220 features on the genomic (
for features that span across introns);
226 sub convert_cDNA_feature {
227 my ($self,$feature) = @_;
232 my @pairs = $self->eachFeaturePair;
235 HOMOL:
while (my $sf1 = shift(@pairs)) {
237 #print STDERR "Looking at cDNA exon " . $sf1->hstart . "\t" . $sf1->hend . "\t" . $sf1->strand ."\n";
239 $skip = 1 unless ($feature->start >= $sf1->hstart
240 && $feature->start <= $sf1->hend);
243 #print STDERR "Skipping ".$sf1->hstart . "\t" . $sf1->hend . "\t" . $sf1->strand ."\n";
246 if ($feature->end >= $sf1->hstart && $feature->end <= $sf1->hend) {
250 my $startcoord = $self->cDNA2genomic($feature->start);
253 if ($sf1->hstrand == 1) {
254 $endcoord = $sf1->end;
256 $endcoord = $sf1->start;
260 $endcoord = $self->cDNA2genomic($feature->end);
263 #print STDERR "Making new genomic feature $startcoord\t$endcoord\n";
266 -start => $startcoord,
268 -strand => $feature->strand);
269 push(@newfeatures,$tmpf);
273 # Now the rest of the pairs until we find the endcoord
275 while ((my $sf1 = shift(@pairs)) && ($foundend == 0)) {
277 if ($feature->end >= $sf1->hstart && $feature->end <= $sf1->hend) {
284 if ($sf1->hstrand == 1) {
285 $startcoord = $sf1->start;
286 $endcoord = $sf1->end;
288 $startcoord = $sf1->end;
289 $endcoord = $sf1->start;
293 $endcoord = $self->cDNA2genomic($feature->end);
296 # #print STDERR "Making new genomic feature $startcoord\t$endcoord\n";
299 -start => $startcoord,
301 -strand => $feature->strand);
302 push(@newfeatures,$tmpf);
304 #print STDERR "Have ".@newfeatures." features from ".$feature."\n";
309 sub convert_FeaturePair {
310 my ($self,$pair) = @_;
312 my $hstrand = $self->get_hstrand;
314 my $feat = $self->create_Feature($pair->start, $pair->end, $pair->strand,
316 my @newfeatures = $self->convert_cDNA_feature($feat);
322 foreach my $new (@newfeatures) {
324 # Now we want to convert these cDNA coords into hit coords
326 my $hstart1 = $self->genomic2cDNA($new->start);
327 my $hend1 = $self->genomic2cDNA($new->end);
329 my $hstart2 = $hitpairaln->genomic2cDNA($hstart1);
330 my $hend2 = $hitpairaln->genomic2cDNA($hend1);
332 # We can now put the final feature together
334 my $finalstrand = $hstrand * $pair->strand * $pair->hstrand;
336 if ($hstart2 > $hend2) {
342 my $finalpair = $self->create_FeaturePair($new->start, $new->end,
345 $finalstrand, $pair->score);
347 push(@newpairs,$finalpair);
354 sub create_FeaturePair {
355 my ($self, $start, $end, $strand, $hstart, $hend,
356 $hstrand, $score) = @_;
364 -hstrand => $hstrand,
373 my ($self, $start, $end, $strand, $slice) = @_;