1
package Bio::Graphics::Glyph::processed_transcript;
3
# $Id: processed_transcript.pm,v 1.12.4.1 2006/10/02 23:10:20 sendu Exp $
6
use base qw(Bio::Graphics::Glyph::transcript2);
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(@_);
151
return $self->feature->primary_tag =~ /UTR|untranslated_region/i;
156
$self->option('thin_utr');
161
return $self->color('utr_color') if $self->option('utr_color');
162
return $self->factory->translate_color(DEFAULT_UTR_COLOR);
167
my $height = $self->SUPER::height;
168
return $height unless $self->thin_utr;
169
return $self->is_utr ? int($height/1.5+0.5) : $height;
174
my $pad_top = $self->SUPER::pad_top;
175
return $pad_top unless $self->thin_utr && $self->is_utr;
176
return $pad_top + int(0.167*$self->SUPER::height + 0.5);
181
return $self->SUPER::bgcolor unless $self->is_utr;
182
return $self->utr_color;
187
return 'quill' if $self->option('decorate_introns');
188
return $self->SUPER::connector(@_);
194
return $self->SUPER::_subfeat(@_) unless ref($self) && $self->{level} == 0 && $self->option('one_cds');
197
my @subparts = $feature->get_SeqFeatures(qw(CDS five_prime_UTR three_prime_UTR UTR));
199
# The CDS and UTRs may be represented as a single feature with subparts or as several features
200
# that have different IDs. We handle both cases transparently.
202
foreach (@subparts) {
203
if ($_->primary_tag =~ /CDS|UTR/i) {
204
my @cds_seg = $_->get_SeqFeatures;
205
if (@cds_seg > 0) { push @result,@cds_seg } else { push @result,$_ }
219
Bio::Graphics::Glyph::processed_transcript - The sequence ontology transcript glyph
223
See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
227
This glyph is used for drawing processed transcripts that have both
228
CDS and UTR segments. The CDS is drawn in the background color, and
229
the UTRs are drawn in an alternate color selected by the utr_color
230
option. In addition, you can make the UTRs thinner than the CDS by
231
setting the "thin_utr" option.
233
For this glyph to produce the desired results, you should pass it a
234
compound Bio::SeqFeature that has subfeatures of primary_tag "CDS" and
235
"UTR". In fact, you may give it more specific types of UTR, including
236
5'-UTR, 3'-UTR, or the Sequence Ontology terms "untranslated_region,"
237
"five_prime_untranslated_region," and
238
"three_prime_untranslated_region."
242
The following options are standard among all Glyphs. See
243
L<Bio::Graphics::Glyph> for a full explanation.
245
Option Description Default
246
------ ----------- -------
248
-fgcolor Foreground color black
250
-outlinecolor Synonym for -fgcolor
252
-bgcolor Background color turquoise
254
-fillcolor Synonym for -bgcolor
256
-linewidth Line width 1
258
-height Height of glyph 10
260
-font Glyph font gdSmallFont
262
-connector Connector type undef (false)
265
Connector color black
267
-label Whether to draw a label undef (false)
269
-description Whether to draw a description undef (false)
271
-strand_arrow Whether to indicate undef (false)
274
-hilite Highlight color undef (no color)
276
In addition, the alignment glyph recognizes the following
277
glyph-specific options:
279
Option Description Default
280
------ ----------- -------
282
-thin_utr Flag. If true, UTRs will undef (false)
283
be drawn at 2/3 of the
284
height of CDS segments.
286
-utr_color Color of UTR segments. Gray #D0D0D0
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.
320
L<Bio::Graphics::Panel>,
321
L<Bio::Graphics::Glyph>,
322
L<Bio::Graphics::Glyph::arrow>,
323
L<Bio::Graphics::Glyph::cds>,
324
L<Bio::Graphics::Glyph::crossbox>,
325
L<Bio::Graphics::Glyph::diamond>,
326
L<Bio::Graphics::Glyph::dna>,
327
L<Bio::Graphics::Glyph::dot>,
328
L<Bio::Graphics::Glyph::ellipse>,
329
L<Bio::Graphics::Glyph::extending_arrow>,
330
L<Bio::Graphics::Glyph::generic>,
331
L<Bio::Graphics::Glyph::graded_segments>,
332
L<Bio::Graphics::Glyph::heterogeneous_segments>,
333
L<Bio::Graphics::Glyph::line>,
334
L<Bio::Graphics::Glyph::pinsertion>,
335
L<Bio::Graphics::Glyph::primers>,
336
L<Bio::Graphics::Glyph::rndrect>,
337
L<Bio::Graphics::Glyph::segments>,
338
L<Bio::Graphics::Glyph::ruler_arrow>,
339
L<Bio::Graphics::Glyph::toomany>,
340
L<Bio::Graphics::Glyph::transcript>,
341
L<Bio::Graphics::Glyph::transcript2>,
342
L<Bio::Graphics::Glyph::translation>,
343
L<Bio::Graphics::Glyph::triangle>,
352
Lincoln Stein E<lt>lstein@cshl.orgE<gt>
354
Copyright (c) 2001 Cold Spring Harbor Laboratory
356
This library is free software; you can redistribute it and/or modify
357
it under the same terms as Perl itself. See DISCLAIMER.txt for
358
disclaimers of warranty.
added
removed
Bio/Graphics/Glyph/processed_transcript.pm
