None available.
sub extend_coord
{ my ($coord, $target_slice) = @_;
throw("Cannot extend coord; wrong slice given")
if $coord->id ne $target_slice->seq_region_name;
my @proj = @{$target_slice->project('seqlevel')};
my ($new_start, $new_end, $up_seg, $down_seg);
foreach my $seg (@proj) {
if ($seg->from_start <= $coord->start and
$seg->from_end >= $coord->start) {
$new_start = $seg->from_start;
} elsif ($seg->from_start <= $coord->start) {
$up_seg = $seg;
}
if ($seg->from_start <= $coord->end and
$seg->from_end >= $coord->end) {
$new_end = $seg->from_end;
} elsif ($seg->from_end >= $coord->end) {
$down_seg = $seg if not defined $down_seg;
}
}
throw("Could not find sequence-level pieces for " .
$coord->id . "/" .
$coord->start . "-" .
$coord->end)
if not defined $new_start or not defined $new_end;
my $ex_coord = Bio::EnsEMBL::Mapper::Coordinate->new($coord->id,
$new_start,
$new_end,
$coord->strand);
my ($up_coord, $down_coord);
if (defined $up_seg) {
$up_coord = Bio::EnsEMBL::Mapper::Coordinate
->new($coord->id,
$up_seg->from_start,
$up_seg->from_end,
$coord->strand);
}
if (defined $down_seg) {
$down_coord = Bio::EnsEMBL::Mapper::Coordinate
->new($coord->id,
$down_seg->from_start,
$down_seg->from_end,
$coord->strand);
}
return ($ex_coord, $up_coord, $down_coord);
}
} |
sub merge_coords
{ my ($ci, $cj) = @_;
my ($start, $end);
if ($cj->start > $ci->start) {
($start, $end) = ($ci->start, $cj->end);
} else {
($start, $end) = ($cj->start, $ci->end);
}
return Bio::EnsEMBL::Mapper::Coordinate->new($ci->id,
$start,
$end,
$ci->strand);
}
} |
sub separate_coords
{ my ($ci, $cj, $target_slice) = @_;
my ($ci_slice, $cj_slice, $between_slice);
my $sa = $target_slice->adaptor;
if (defined $ci and defined $cj) {
$ci_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$ci->start,
$ci->end);
$cj_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$cj->start,
$cj->end);
$between_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$ci->end + 1,
$cj->start - 1);
} elsif (defined $ci) {
$ci_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$ci->start,
$ci->end);
$between_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$ci->end + 1,
$target_slice->length);
} elsif (defined $cj) {
$cj_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
$cj->start,
$cj->end);
$between_slice = $sa->fetch_by_region('toplevel',
$target_slice->seq_region_name,
1,
$cj->start - 1);
}
my (@seq_level_i, @seq_level_j, @between);
if (defined $ci_slice) {
@seq_level_i = map {
{
from_start => $_->from_start + $ci_slice->start - 1,
from_end => $_->from_end + $ci_slice->start - 1,
to_Slice => $_->to_Slice,
};
} @{$ci_slice->project('seqlevel')};
}
if (defined $cj_slice) {
@seq_level_j = map {
{
from_start => $_->from_start + $cj_slice->start - 1,
from_end => $_->from_end + $cj_slice->start - 1,
to_Slice => $_->to_Slice,
};
} @{$cj_slice->project('seqlevel')};
}
@between = map {
{
from_start => $_->from_start + $between_slice->start - 1,
from_end => $_->from_end + $between_slice->start - 1,
to_Slice => $_->to_Slice,
};
} @{$between_slice->project('seqlevel')};
my $between_seq_coverage = 0;
foreach my $bit (@between) {
$between_seq_coverage += $bit->{from_end} - $bit->{from_start} +1;
}
if ( not @seq_level_i or
not @seq_level_j or
$seq_level_i[-1]->{from_end} < $ci->end or
$seq_level_j[0]->{from_start} > $cj->start or
$between_seq_coverage < $between_slice->length) {
my ($new_left, $new_right);
if (defined $ci) {
if (not @between or
$between[0]->{from_start} > $between_slice->start) {
$new_left = Bio::EnsEMBL::Mapper::Coordinate->
new($ci->id,
$ci->start,
$ci->end,
$ci->strand);
} else {
$new_left = Bio::EnsEMBL::Mapper::Coordinate->
new($ci->id,
$ci->start,
$between[0]->{from_end},
$ci->strand);
}
}
if (defined $cj) {
if (not @between or $between[-1]->{from_end} < $between_slice->end) {
$new_right = Bio::EnsEMBL::Mapper::Coordinate->
new($cj->id,
$cj->start,
$cj->end,
$cj->strand);
} else {
$new_right = Bio::EnsEMBL::Mapper::Coordinate->
new($cj->id,
$between[-1]->{from_start},
$cj->end,
$cj->strand);
}
}
if (defined $new_left and defined $new_right) {
return ($new_left, $new_right);
} elsif (defined $new_left and not defined $new_right) {
return ($new_left, undef);
} elsif (defined $new_right and not defined $new_left) {
return (undef, $new_right);
}
}
return (undef, undef);
}
} |
sub transcripts_to_coords
{ my ($map, $from_cs_name, @trans) = @_;
my (@all_good_bits, @results);
foreach my $tr (@trans) {
my @exons = sort {$a->start <=> $b->start} @{$tr->get_all_translateable_Exons};
my @bits;
for(my $i = 0; $i < @exons; $i++) {
my $e = $exons[$i];
my @c = $map->map_coordinates($e->slice->seq_region_name,
$e->start,
$e->end,
1,
$from_cs_name);
my $current_pos = $e->start;
foreach my $c (@c) {
my $current_end = $current_pos + $c->length - 1;
if ($c->isa("Bio::EnsEMBL::Mapper::Coordinate")) {
push @bits, Bio::EnsEMBL::Mapper::Coordinate->new($e->slice->seq_region_name,
$current_pos,
$current_end,
1);
} else {
push @bits, $c;
}
$current_pos += $c->length;
}
}
my $total_bps = 0;
my $first_good = -1;
for(my $i=0; $i < @bits; $i++) {
if ($bits[$i]->isa("Bio::EnsEMBL::Mapper::Coordinate")) {
my $spare_start = (3 - ($total_bps % 3)) % 3;
my $spare_end = ($bits[$i]->length - $spare_start) % 3;
my $codons = ($bits[$i]->length - $spare_start - $spare_end) / 3;
if ($codons >= 1) {
$first_good = $i;
last;
}
}
$total_bps += $bits[$i]->length;
}
next if $first_good < 0;
@bits = splice(@bits, $first_good, scalar(@bits) - $first_good);
$total_bps = 0;
$first_good = -1;
for(my $i=scalar(@bits) - 1; $i >= 0; $i--) {
if ($bits[$i]->isa("Bio::EnsEMBL::Mapper::Coordinate")) {
my $spare_end = (3 - ($total_bps % 3)) % 3;
my $spare_start = ($bits[$i]->length - $spare_end) % 3;
my $codons = ($bits[$i]->length - $spare_start - $spare_end) / 3;
if ($codons >= 1) {
$first_good = $i;
last;
}
}
$total_bps += $bits[$i]->length;
}
next if $first_good < 0;
@bits = splice(@bits, 0, $first_good + 1);
push @all_good_bits, @bits;
}
@all_good_bits = sort { $a->start <=> $b->start } @all_good_bits;
foreach my $g (@all_good_bits) {
if (not @results or
$results[-1]->end < $g->start - 1) {
push @results, Bio::EnsEMBL::Mapper::Coordinate->
new($trans[0]->slice->seq_region_name,
$g->start,
$g->end,
1);
} else {
if ($g->end > $results[-1]->end) {
$results[-1]->end($g->end);
}
}
}
return\@ results;
}
1; } |