1
1
package Bio::Graphics::Glyph::processed_transcript;
3
# $Id: processed_transcript.pm,v 1.4 2003/09/17 17:11:30 lstein Exp $
3
# $Id: processed_transcript.pm,v 1.12.4.1 2006/10/02 23:10:20 sendu Exp $
6
use Bio::Graphics::Glyph::transcript2;
8
@ISA = 'Bio::Graphics::Glyph::transcript2';
6
use base qw(Bio::Graphics::Glyph::transcript2);
9
7
use constant DEFAULT_UTR_COLOR => '#D0D0D0';
11
my $self = $class->SUPER::new(@_);
12
$self->guess_options if !defined $self->option('implied_utrs')
13
&& !defined $self->option('adjust_exons');
19
my ($exons,$utrs,$cds);
20
foreach ($self->parts) {
21
$exons++ if $_->feature->type =~ /exon/i;
22
$utrs++ if $_->feature->type =~ /utr$/i;
23
$cds++ if $_->feature->type =~ /^cds/i;
24
$self->configure(implied_utrs=>1) if $exons && $cds && !$utrs;
25
$self->configure(adjust_exons=>1) if $exons && $utrs;
29
# this option will generate implied UTRs by subtracting the
30
# CDS features from the exons.
31
sub create_implied_utrs {
33
return if $self->{'.implied_utrs'}++;
35
# parts should be ordered from left to right
36
my @features = sort {$a->start <=> $b->start} map {$_->feature} $self->parts;
37
my @exons = grep {$_->type eq 'exon'} @features;
38
my @cds = grep {$_->type eq 'CDS'} @features;
39
my @old_utr = grep {$_->type =~ /UTR/} @features;
41
# if there are already UTRs then we don't modify anything
44
# if exons or CDS features are missing, then we abandon ship
45
return unless @exons && @cds;
47
my $first_cds = $cds[0];
48
my $last_cds = $cds[-1];
49
my $strand = $self->feature->strand;
51
my $factory = $self->factory;
53
# make the left-hand UTRs
54
for (my $i=0;$i<@exons;$i++) {
55
my $start = $exons[$i]->start;
56
last if $start >= $first_cds->start;
57
my $end = $first_cds->start > $exons[$i]->end ? $exons[$i]->end : $first_cds->start-1;
58
my $utr = Bio::Graphics::Feature->new(-start=>$start,
61
-type=>$strand >= 0 ? 'five_prime_UTR' : 'three_prime_UTR');
62
unshift @{$self->{parts}},$factory->make_glyph($self->{level}+1,$utr);
64
# make the right-hand UTRs
65
for (my $i=$#exons; $i>=0; $i--) {
66
my $end = $exons[$i]->end;
67
last if $end <= $last_cds->end;
68
my $start = $last_cds->end < $exons[$i]->start ? $exons[$i]->start : $last_cds->end+1;
69
my $utr = Bio::Graphics::Feature->new(-start=>$start,
72
-type=>$strand >= 0 ? 'three_prime_UTR' : 'five_prime_UTR');
73
push @{$self->{parts}},$factory->make_glyph($self->{level}+1,$utr);
77
# Preprocess the glyph to remove overlaps between UTRs and
78
# exons. The exons are clipped so that UTRs have precedence
82
return if $self->{'.adjust_exons'}++;
84
# find everything that is not an exon (utrs and cds's)
85
my @parts = sort {$a->{left}<=>$b->{left}} $self->parts;
86
my @exon = grep {$_->feature->type =~ /exon/i} @parts;
87
my %seen = map {$_=>1} @exon;
88
my @other = grep {!$seen{$_}} @parts;
91
my %positions = map {("$_->{left}:$_->{width}" =>1)} @other;
92
my @unique_exons = grep {!$positions{"$_->{left}:$_->{width}"}} @exon;
94
# the first and last exons may need to be clipped if they overlap
95
# with another feature (CDS or UTR)
96
my $first_exon = $unique_exons[0];
97
my $last_exon = $unique_exons[-1];
99
# deal with left hand side first
100
my $e_left = $first_exon->{left};
101
my $e_right = $e_left + $first_exon->{width};
102
for my $other (@other) {
103
my $o_left = $other->{left};
104
my $o_right = $o_left + $other->{width};
105
next if $e_left > $o_right;
106
last if $e_right < $o_left;
107
#dgg- need to skip 3prime/right utr for 1exon; end same as exon
108
last if (@unique_exons == 1 && $o_left > $e_left); #dgg- o_ is 3prime not 5
109
# clip left hand side; may get clipped into oblivion!
110
$first_exon->{left} = $o_right + 1;
111
$first_exon->{width} = $e_right - $first_exon->{left};
114
# deal with right hand side
115
$e_left = $last_exon->{left};
116
$e_right = $e_left + $last_exon->{width};
117
for (my $i=$#other; $i>=0; $i--) {
118
my $o_left = $other[$i]->{left};
119
my $o_right = $o_left + $other[$i]->{width};
120
next if $e_right < $o_left;
121
last if $e_left > $o_right;
122
# clip right hand side; may get clipped into oblivion!
123
#dgg- !! this always clips to oblivion: $last_exon->{width} = ($e_left - 1) - $last_exon->{left};
124
$last_exon->{width} = $o_left - $last_exon->{left}; #dgg-
127
$self->{parts} = [ grep {$_->width > 0} sort {$a->{left}<=>$b->{left}} (@other,@unique_exons)];
132
return unless $self->level == 0;
133
$self->create_implied_utrs if $self->option('implied_utrs');
134
$self->adjust_exons if $self->option('implied_utrs') || $self->option('adjust_exons');
139
$self->fixup_glyph();
140
$self->SUPER::draw(@_);
145
$self->fixup_glyph();
146
$self->SUPER::boxes(@_);
13
151
return $self->feature->primary_tag =~ /UTR|untranslated_region/i;
131
289
Draw strand with little arrows undef (false)
292
-adjust_exons Fix exons so that they don't undef (false)
295
-implied_utrs Whether UTRs should be implied undef (false)
296
from exons and CDS features
298
-one_cds Some databases (e.g. FlyBase) represent their
299
transcripts as having a single CDS that is
300
broken up into multiple parts. Set this to
301
true to display this type of feature.
303
The B<-adjust_exons> option is needed to handle features in which the
304
exons (SO type "exon") overlaps with the UTRs (SO types
305
"five_prime_UTR" and "three_prime_UTR"). The exon parts of the glyph
306
will be clipped so that it doesn't overlap with the UTR parts.
308
The B<-implied_utrs> option is needed if there are no explicit UTR
309
features. In this case, UTRs are derived by subtracting the positions
310
of "CDS" subfeatures from the positions of "exon" subfeatures.
311
B<-implied_utrs> implies the B<-adjust_exons> option.
136
315
Please report them.
added
removed
Bio/Graphics/Glyph/processed_transcript.pm
