← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/Graphics/Glyph/translation.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Graphics/Glyph/translation.pm
1
 
package Bio::Graphics::Glyph::translation;
2
 
 
3
 
use strict;
4
 
use Bio::Graphics::Util qw(frame_and_offset);
5
 
use base qw(Bio::Graphics::Glyph::generic);
6
 
 
7
 
my %default_colors = qw(
8
 
                        frame0f  cornflowerblue
9
 
                        frame1f  blue
10
 
                        frame2f  darkblue
11
 
                        frame0r  magenta
12
 
                        frame1r  red
13
 
                        frame2r  darkred
14
 
                       );
15
 
 
16
 
# turn off description
17
 
sub description { 0 }
18
 
 
19
 
# turn off label
20
 
# sub label { 1 }
21
 
 
22
 
sub default_color {
23
 
  my ($self,$key) = @_;
24
 
  return $self->factory->translate_color($default_colors{$key});
25
 
}
26
 
 
27
 
sub height {
28
 
  my $self = shift;
29
 
  my $font = $self->font;
30
 
  my $lines = $self->translation_type eq '3frame' ? 3
31
 
            : $self->translation_type eq '6frame' ? 6
32
 
            : 1;
33
 
  return $self->protein_fits ? $lines*$font->height
34
 
       : $self->SUPER::height;
35
 
}
36
 
 
37
 
sub pixels_per_base {
38
 
  my $self = shift;
39
 
  return $self->scale;
40
 
}
41
 
 
42
 
sub pixels_per_residue {
43
 
  my $self = shift;
44
 
  return $self->scale * 3;
45
 
}
46
 
 
47
 
sub gridcolor {
48
 
  my $self = shift;
49
 
  my $color = $self->option('gridcolor') || 'lightgrey';
50
 
  $self->factory->translate_color($color);
51
 
}
52
 
 
53
 
sub show_sequence {
54
 
  my $self = shift;
55
 
  my $show_sequence = $self->option('show_sequence');
56
 
  return 1 unless defined $show_sequence;  # default to true
57
 
  return $show_sequence;
58
 
}
59
 
 
60
 
sub triletter_code {
61
 
  my $self = shift;
62
 
  my $triletter_code = $self->option("triletter_code");
63
 
  return 0 unless defined $triletter_code; # default to false
64
 
  return $triletter_code;
65
 
}
66
 
 
67
 
sub longprotein_fits {
68
 
  my $self = shift;
69
 
  return unless $self->show_sequence;
70
 
 
71
 
  my $pixels_per_residue = $self->pixels_per_residue;
72
 
  my $font               = $self->font;
73
 
  my $font_width         = $font->width * 4; # not 3; leave room for whitespace
74
 
 
75
 
  return $pixels_per_residue >= $font_width;
76
 
}
77
 
 
78
 
sub translation_type {
79
 
  my $self = shift;
80
 
  return $self->option('translation') || '1frame';
81
 
}
82
 
 
83
 
sub arrow_height {
84
 
  my $self = shift;
85
 
  $self->option('arrow_height') || 1;
86
 
}
87
 
 
88
 
sub show_stop_codons {
89
 
  my $self = shift;
90
 
  my $show = $self->option('stop_codons');
91
 
  return $show if defined $show;
92
 
  return 1;
93
 
}
94
 
 
95
 
sub show_start_codons {
96
 
  my $self = shift;
97
 
  my $show = $self->option('start_codons');
98
 
  return $show if defined $show;
99
 
  return 0;
100
 
}
101
 
 
102
 
sub strand {
103
 
  my $self = shift;
104
 
  return $self->option('strand') || '+1';
105
 
}
106
 
 
107
 
sub draw_component {
108
 
  my $self = shift;
109
 
  my $gd = shift;
110
 
  my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
111
 
 
112
 
  my $type   = $self->translation_type;
113
 
  my $strand = $self->strand;
114
 
 
115
 
  my @strands =  $type eq '6frame' ? (1,-1)
116
 
               : $strand > 0       ? (1)
117
 
               : -1;
118
 
  my @phase = (0,1,2);
119
 
  for my $s (@strands) {
120
 
    for (my $i=0; $i < @phase; $i++) {
121
 
      $self->draw_frame($self->feature,$s,$i,$phase[$i],$gd,$x1,$y1,$x2,$y2);
122
 
    }
123
 
  }
124
 
 
125
 
}
126
 
 
127
 
sub draw_frame {
128
 
  my $self = shift;
129
 
  my ($feature,$strand,$base_offset,$phase,$gd,$x1,$y1,$x2,$y2) = @_;
130
 
  my ($seq,$pos);
131
 
  $seq = $feature->seq or return; # no sequence, arggh.
132
 
 
133
 
  my $strand0 = $strand;
134
 
  $strand *= -1 if $self->{flip};
135
 
 
136
 
  $pos = $strand < 0 ? $feature->end : $feature->start;
137
 
 
138
 
  my ($frame,$offset) = frame_and_offset($pos,$strand,$phase);
139
 
  # warn "frame=$frame, phase=$phase";
140
 
 
141
 
  my ($x1_orig,$x2_orig) = ($x1,$x2);  # remember this for arrowheads
142
 
 
143
 
  ($strand >= 0 ? $x1 : $x2) += $self->pixels_per_base * $offset;
144
 
  my $y0 = $y1;
145
 
  my $lh;
146
 
  if ($self->translation_type eq '6frame') {
147
 
    $lh = $self->height / 6;
148
 
    $y1 += $lh * $frame;
149
 
    $y1 += $self->height/2 if $strand < 0;
150
 
  } else {
151
 
    $lh = $self->height / 3;
152
 
    $y1 += $lh * $frame;
153
 
  }
154
 
 
155
 
  $y1  = $y0 + ($self->height - ($y1-$y0)) - $lh if $self->{flip};
156
 
 
157
 
  $y2 = $y1;
158
 
 
159
 
  my $codon_table = $self->option('codontable') || $self->option('geneticcode') || 1;
160
 
 
161
 
  # the dreaded difference between a Bio::SeqFeature and a Bio::Seq
162
 
 
163
 
  my $realseq  = $self->get_seq($seq);
164
 
  return unless $realseq;
165
 
  $realseq    = $realseq->revcom if $strand < 0;
166
 
 
167
 
  my $protein = $realseq->translate(undef,undef,$base_offset,$codon_table)->seq;
168
 
 
169
 
  my $k       = $strand >= 0     ? 'f' : 'r';
170
 
 
171
 
  my $color   = $self->color("frame$frame$k") ||
172
 
                $self->color("frame$frame") ||
173
 
                $self->default_color("frame$frame$k") || $self->fgcolor;
174
 
 
175
 
  my $awo = 0;
176
 
  if ($self->protein_fits) {
177
 
    $self->draw_protein(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
178
 
    $awo += $self->font->height/2;
179
 
  } else {
180
 
    $self->draw_orfs(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
181
 
  }
182
 
 
183
 
  $strand0 > 0 ? $self->arrowhead($gd,$x2_orig+5,$y1+$awo,3,+1)
184
 
               : $self->arrowhead($gd,$x1_orig-5,$y1+$awo,3,-1)
185
 
 
186
 
}
187
 
 
188
 
sub draw_protein {
189
 
  my $self = shift;
190
 
  my ($protein,$strand,$color,$gd,$x1,$y1,$x2,$y2) = @_;
191
 
  my $pixels_per_base = $self->pixels_per_base;
192
 
  my $font   = $self->font;
193
 
  my $flip   = $self->{flip};
194
 
  my $left   = $self->panel->left;
195
 
  my $right  = $self->panel->right;
196
 
 
197
 
  my $longprotein = $self->triletter_code && $self->longprotein_fits;
198
 
 
199
 
  my %abbrev = ( A => "Ala", B => "Asx", C => "Cys", D => "Asp",
200
 
                 E => "Glu", F => "Phe", G => "Gly", H => "His",
201
 
                 I => "Ile", J => "???", K => "Lys", L => "Leu",
202
 
                 M => "Met", N => "Asn", O => "???", P => "Pro",
203
 
                 Q => "Gln", R => "Arg", S => "Ser", T => "Thr",
204
 
                 U => "Sec", V => "Val", W => "Trp", X => "Xaa",
205
 
                 Y => "Tyr", Z => "Glx", '*' => " * ",
206
 
               );
207
 
 
208
 
  my @residues = split '',$$protein;
209
 
  my $fontwidth = $font->width;
210
 
  for (my $i=0;$i<@residues;$i++) {
211
 
    my $x = $strand > 0
212
 
      ? $x1 + 3 * $i * $pixels_per_base
213
 
      : $x2 - 3 * $i * $pixels_per_base - $pixels_per_base;
214
 
    next if $x+1 < $x1;
215
 
    last if $x > $x2;
216
 
    if ($flip) {
217
 
      $x -= $pixels_per_base - $font->width - 1; #align right, not left
218
 
      if ($longprotein) {
219
 
        $gd->string($font,$right-($x-$left+$pixels_per_base)+1,$y1,$abbrev{$residues[$i]},$color);
220
 
      } else {
221
 
        $gd->char($font,$right-($x-$left+$pixels_per_base)+2,$y1,$residues[$i],$color);
222
 
      }
223
 
    } else {
224
 
      if ($longprotein) {
225
 
        $gd->string($font, $x+1, $y1, $abbrev{$residues[$i]}, $color);
226
 
      } else {
227
 
        $gd->char($font,$x+2,$y1,$residues[$i],$color);
228
 
      }
229
 
    }
230
 
  }
231
 
}
232
 
 
233
 
sub draw_orfs {
234
 
  my $self     = shift;
235
 
  my ($protein,$strand,$color,$gd,$x1,$y1,$x2,$y2) = @_;
236
 
  my $pixels_per_base = $self->pixels_per_base * 3;
237
 
  $y1++;
238
 
  my $right  = $self->panel->right;
239
 
  my $left   = $self->panel->left;
240
 
  my $flip   = $self->{flip};
241
 
 
242
 
  my $gcolor = $self->gridcolor;
243
 
  $gd->line($x1,$y1,$x2,$y1,$gcolor);
244
 
 
245
 
  if ($self->show_stop_codons) {
246
 
    my $stops  = $self->find_codons($protein,'*');
247
 
 
248
 
    for my $stop (@$stops) {
249
 
      my $pos = $strand > 0 
250
 
        ? $x1 + $stop * $pixels_per_base
251
 
        : $x2 - $stop * $pixels_per_base;
252
 
      next if $pos+1 < $x1;
253
 
      last if $pos   > $x2;
254
 
      if ($flip) {
255
 
        $gd->line($right-($pos-$left),$y1-2,$right-($pos-$left),$y1+2,$color);
256
 
      } else {
257
 
        $gd->line($pos,$y1-2,$pos,$y1+2,$color);
258
 
      }
259
 
    }
260
 
  }
261
 
 
262
 
  my $arrowhead_height = $self->arrow_height;
263
 
 
264
 
  if ($self->show_start_codons) {
265
 
    my $starts  = $self->find_codons($protein,'M');
266
 
 
267
 
    for my $start (@$starts) {
268
 
      my $pos = $strand > 0 
269
 
        ? $x1 + $start * $pixels_per_base
270
 
        : $x2 - $start * $pixels_per_base;
271
 
      next if $pos+1 < $x1;
272
 
      last if $pos   > $x2;
273
 
      $pos = $self->{flip} ? $right - $pos : $pos;
274
 
 
275
 
      # little arrowheads at the start codons
276
 
      $strand > 0 ? $self->arrowhead($gd,$pos-$arrowhead_height,$y1,
277
 
                                     $arrowhead_height,+1)
278
 
                  : $self->arrowhead($gd,$pos+$arrowhead_height,$y1,
279
 
                                     $arrowhead_height,-1)
280
 
    }
281
 
  }
282
 
  $strand *= -1 if $flip;
283
 
 
284
 
}
285
 
 
286
 
sub find_codons {
287
 
  my $self    = shift;
288
 
  my $protein = shift;
289
 
  my $codon   = shift || '*';
290
 
  my $pos = -1;
291
 
  my @stops;
292
 
  while ( ($pos = index($$protein,$codon,$pos+1)) >= 0) {
293
 
    push @stops,$pos;
294
 
  }
295
 
  \@stops;
296
 
}
297
 
 
298
 
sub make_key_feature {
299
 
  my $self = shift;
300
 
  my @gatc = qw(g a t c);
301
 
  my $offset = $self->panel->offset;
302
 
  my $scale = 1/$self->scale;  # base pairs/pixel
303
 
  my $start = $offset;
304
 
  my $stop  = $offset + 100 * $scale;
305
 
  my $seq   = join('',map{$gatc[rand 4]} (1..500));
306
 
  my $feature =
307
 
    Bio::Graphics::Feature->new(-start=> $start,
308
 
                                -end  => $stop,
309
 
                                -seq  => $seq,
310
 
                                -name => $self->option('key')
311
 
                               );
312
 
  $feature;
313
 
}
314
 
 
315
 
1;
316
 
 
317
 
__END__
318
 
 
319
 
=head1 NAME
320
 
 
321
 
Bio::Graphics::Glyph::translation - The "6-frame translation" glyph
322
 
 
323
 
=head1 SYNOPSIS
324
 
 
325
 
  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
326
 
 
327
 
=head1 DESCRIPTION
328
 
 
329
 
This glyph draws the conceptual translation of DNA sequences.  At high
330
 
magnifications, it simply draws lines indicating open reading frames.
331
 
At low magnifications, it draws a conceptual protein translation.
332
 
Options can be used to set 1-frame, 3-frame or 6-frame translations.
333
 
 
334
 
=head2 OPTIONS
335
 
 
336
 
The following options are standard among all Glyphs.  See
337
 
L<Bio::Graphics::Glyph> for a full explanation.
338
 
 
339
 
  Option      Description                      Default
340
 
  ------      -----------                      -------
341
 
 
342
 
  -fgcolor      Foreground color               black
343
 
 
344
 
  -outlinecolor Synonym for -fgcolor
345
 
 
346
 
  -bgcolor      Background color               turquoise
347
 
 
348
 
  -fillcolor    Synonym for -bgcolor
349
 
 
350
 
  -linewidth    Line width                     1
351
 
 
352
 
  -height       Height of glyph                10
353
 
 
354
 
  -font         Glyph font                     gdSmallFont
355
 
 
356
 
  -connector    Connector type                 0 (false)
357
 
 
358
 
  -connector_color
359
 
                Connector color                black
360
 
 
361
 
  -label        Whether to draw a label        0 (false)
362
 
 
363
 
  -description  Whether to draw a description  0 (false)
364
 
 
365
 
  -hilite       Highlight color                undef (no color)
366
 
 
367
 
In addition to the common options, the following glyph-specific
368
 
options are recognized:
369
 
 
370
 
  Option        Description                 Default
371
 
  ------        -----------                 -------
372
 
 
373
 
  -translation  Type of translation to      1frame
374
 
                perform.  One of "1frame",
375
 
                "3frame", or "6frame"
376
 
 
377
 
  -strand       Forward (+1) or reverse (-1) +1
378
 
                translation.
379
 
 
380
 
  -frame0       Color for the first frame    fgcolor
381
 
 
382
 
  -frame1       Color for the second frame   fgcolor
383
 
 
384
 
  -frame2       Color for the third frame    fgcolor
385
 
 
386
 
  -gridcolor    Color for the horizontal     lightgrey
387
 
                lines of the reading frames
388
 
 
389
 
  -start_codons Draw little arrowheads       0 (false)
390
 
                indicating start codons
391
 
 
392
 
  -stop_codons  Draw little vertical ticks   1 (true)
393
 
                indicating stop codons
394
 
 
395
 
  -arrow_height Height of the start codon    1
396
 
                arrowheads
397
 
 
398
 
  -show_sequence Show the amino acid sequence 1 (true)
399
 
                if there's room.
400
 
 
401
 
  -triletter_code Show the 3-letter amino acid 0 (false)
402
 
                code if there's room
403
 
 
404
 
  -codontable   Codon table to use           1 (see Bio::Tools::CodonTable)
405
 
 
406
 
=head1 SUGGESTED STANZA FOR GENOME BROWSER
407
 
 
408
 
This produces a nice gbrowse display in which the DNA/GC Content glyph
409
 
is sandwiched between the forward and reverse three-frame
410
 
translations.  The frames are color-coordinated with the example
411
 
configuration for the "cds" glyph.
412
 
 
413
 
 [TranslationF]
414
 
 glyph        = translation
415
 
 global feature = 1
416
 
 frame0       = cadetblue
417
 
 frame1       = blue
418
 
 frame2       = darkblue
419
 
 height       = 20
420
 
 fgcolor      = purple
421
 
 strand       = +1
422
 
 translation  = 3frame
423
 
 key          = 3-frame translation (forward)
424
 
 
425
 
 [DNA/GC Content]
426
 
 glyph        = dna
427
 
 global feature = 1
428
 
 height       = 40
429
 
 do_gc        = 1
430
 
 fgcolor      = red
431
 
 axis_color   = blue
432
 
 
433
 
 [TranslationR]
434
 
 glyph        = translation
435
 
 global feature = 1
436
 
 frame0       = darkred
437
 
 frame1       = red
438
 
 frame2       = crimson
439
 
 height       = 20
440
 
 fgcolor      = blue
441
 
 strand       = -1
442
 
 translation  = 3frame
443
 
 key          = 3-frame translation (reverse)
444
 
 
445
 
=head1 BUGS
446
 
 
447
 
Please report them.
448
 
 
449
 
=head1 SEE ALSO
450
 
 
451
 
 
452
 
L<Bio::Graphics::Panel>,
453
 
L<Bio::Graphics::Glyph>,
454
 
L<Bio::Graphics::Glyph::arrow>,
455
 
L<Bio::Graphics::Glyph::cds>,
456
 
L<Bio::Graphics::Glyph::crossbox>,
457
 
L<Bio::Graphics::Glyph::diamond>,
458
 
L<Bio::Graphics::Glyph::dna>,
459
 
L<Bio::Graphics::Glyph::dot>,
460
 
L<Bio::Graphics::Glyph::ellipse>,
461
 
L<Bio::Graphics::Glyph::extending_arrow>,
462
 
L<Bio::Graphics::Glyph::generic>,
463
 
L<Bio::Graphics::Glyph::graded_segments>,
464
 
L<Bio::Graphics::Glyph::heterogeneous_segments>,
465
 
L<Bio::Graphics::Glyph::line>,
466
 
L<Bio::Graphics::Glyph::pinsertion>,
467
 
L<Bio::Graphics::Glyph::primers>,
468
 
L<Bio::Graphics::Glyph::rndrect>,
469
 
L<Bio::Graphics::Glyph::segments>,
470
 
L<Bio::Graphics::Glyph::ruler_arrow>,
471
 
L<Bio::Graphics::Glyph::toomany>,
472
 
L<Bio::Graphics::Glyph::transcript>,
473
 
L<Bio::Graphics::Glyph::transcript2>,
474
 
L<Bio::Graphics::Glyph::translation>,
475
 
L<Bio::Graphics::Glyph::triangle>,
476
 
L<Bio::DB::GFF>,
477
 
L<Bio::SeqI>,
478
 
L<Bio::SeqFeatureI>,
479
 
L<Bio::Das>,
480
 
L<GD>
481
 
 
482
 
=head1 AUTHOR
483
 
 
484
 
Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
485
 
 
486
 
Copyright (c) 2001 Cold Spring Harbor Laboratory
487
 
 
488
 
This library is free software; you can redistribute it and/or modify
489
 
it under the same terms as Perl itself.  See DISCLAIMER.txt for
490
 
disclaimers of warranty.
491
 
 
492
 
=cut