← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Graphics/Glyph/dna.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/dna.pm
1
 
package Bio::Graphics::Glyph::dna;
2
 
 
3
 
use strict;
4
 
use base qw(Bio::Graphics::Glyph::generic);
5
 
 
6
 
my %complement = (g=>'c',a=>'t',t=>'a',c=>'g',n=>'n',
7
 
                  G=>'C',A=>'T',T=>'A',C=>'G',N=>'N');
8
 
 
9
 
# turn off description
10
 
sub description { 0 }
11
 
 
12
 
# turn off label
13
 
# sub label { 1 }
14
 
 
15
 
sub height {
16
 
  my $self = shift;
17
 
  my $font = $self->font;
18
 
  return $self->dna_fits ? 2*$font->height
19
 
       : $self->do_gc    ? $self->SUPER::height
20
 
       : 0;
21
 
}
22
 
 
23
 
sub do_gc {
24
 
  my $self = shift;
25
 
  my $do_gc = $self->option('do_gc');
26
 
  return  if defined($do_gc) && !$do_gc;
27
 
  return  1;
28
 
}
29
 
 
30
 
sub draw_component {
31
 
  my $self = shift;
32
 
  my $gd = shift;
33
 
  my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
34
 
 
35
 
  my $dna        = eval { $self->feature->seq };
36
 
  $dna           = $dna->seq if ref($dna) and $dna->can('seq'); # to catch Bio::PrimarySeqI objects
37
 
  $dna or return;
38
 
 
39
 
  # workaround for my misreading of interface -- LS
40
 
  $dna = $dna->seq if ref($dna) && $dna->can('seq');
41
 
 
42
 
  if ($self->dna_fits) {
43
 
    $self->draw_dna($gd,$dna,$x1,$y1,$x2,$y2);
44
 
  } elsif ($self->do_gc) {
45
 
    $self->draw_gc_content($gd,$dna,$x1,$y1,$x2,$y2);
46
 
  }
47
 
}
48
 
 
49
 
sub draw_dna {
50
 
  my $self = shift;
51
 
 
52
 
  my ($gd,$dna,$x1,$y1,$x2,$y2) = @_;
53
 
  my $pixels_per_base = $self->scale;
54
 
  my $feature = $self->feature;
55
 
 
56
 
  my $strand = $feature->strand || 1;
57
 
  $strand *= -1 if $self->{flip};
58
 
 
59
 
  my @bases = split '',$strand >= 0 ? $dna : $self->reversec($dna);
60
 
 
61
 
  my $color = $self->fgcolor;
62
 
  my $font  = $self->font;
63
 
  my $lineheight = $font->height;
64
 
  $y1 -= $lineheight/2 - 3;
65
 
  my $strands = $self->option('strand') || 'auto';
66
 
 
67
 
  my ($forward,$reverse);
68
 
  if ($strands eq 'auto') {
69
 
    $forward = $feature->strand >= 0;
70
 
    $reverse = $feature->strand <= 0;
71
 
  } elsif ($strands eq 'both') {
72
 
    $forward = $reverse = 1;
73
 
  } elsif ($strands eq 'reverse') {
74
 
    $reverse = 1;
75
 
  } else {
76
 
    $forward = 1;
77
 
  }
78
 
  # minus strand features align right, not left
79
 
  $x1 += $pixels_per_base - $font->width - 1 if $strand < 0;
80
 
  for (my $i=0;$i<@bases;$i++) {
81
 
    my $x = $x1 + $i * $pixels_per_base;
82
 
    $gd->char($font,$x+2,$y1,$bases[$i],$color)                                   if $forward;
83
 
    $gd->char($font,$x+2,$y1+($forward ? $lineheight:0),
84
 
              $complement{$bases[$i]}||$bases[$i],$color)                         if $reverse;
85
 
  }
86
 
 
87
 
}
88
 
 
89
 
sub draw_gc_content {
90
 
  my $self     = shift;
91
 
  my $gd       = shift;
92
 
  my $dna      = shift;
93
 
  my ($x1,$y1,$x2,$y2) = @_;
94
 
 
95
 
# get the options that tell us how to draw the GC content
96
 
 
97
 
  my $bin_size = length($dna) / ($self->option('gc_bins') || 100);
98
 
  $bin_size = 10 if $bin_size < 10;
99
 
  my $gc_window = $self->option('gc_window');
100
 
  if ($gc_window && $gc_window eq 'auto' or $gc_window <= length($dna)) {
101
 
    $gc_window = length($dna)/100;
102
 
  }
103
 
 
104
 
# Calculate the GC content...
105
 
 
106
 
  my @bins;
107
 
  my @datapoints;
108
 
  my $maxgc = -1000;
109
 
  my $mingc = +1000;
110
 
  if ($gc_window)
111
 
  {
112
 
 
113
 
# ...using a sliding window...
114
 
    for (my $i=$gc_window/2; $i <= length($dna) - $gc_window/2; $i++)
115
 
      {
116
 
        my $subseq = substr($dna, $i-$gc_window/2, $gc_window);
117
 
        my $gc = $subseq =~ tr/gcGC/gcGC/;
118
 
        my $content = $gc / $gc_window;
119
 
        push @datapoints, $content;
120
 
        $maxgc = $content if ($content > $maxgc);
121
 
        $mingc = $content if ($content < $mingc);
122
 
      }
123
 
    push @datapoints, 0.5 unless @datapoints;
124
 
 
125
 
    my $scale = $maxgc - $mingc;
126
 
    foreach (my $i; $i < @datapoints; $i++)
127
 
      {
128
 
        $datapoints[$i] = ($datapoints[$i] - $mingc) / $scale;
129
 
      }
130
 
    $maxgc = int($maxgc * 100);
131
 
    $mingc = int($mingc * 100);
132
 
  }
133
 
  else
134
 
  {
135
 
 
136
 
# ...or a fixed number of bins.
137
 
 
138
 
    for (my $i = 0; $i < length($dna) - $bin_size; $i+= $bin_size) {
139
 
      my $subseq  = substr($dna,$i,$bin_size);
140
 
      my $gc      = $subseq =~ tr/gcGC/gcGC/;
141
 
      my $content = $gc/$bin_size;
142
 
      $maxgc = $content if ($content > $maxgc);
143
 
      $mingc = $content if ($content < $mingc);
144
 
      push @bins,$content;
145
 
    }
146
 
 
147
 
    my $scale = $maxgc - $mingc;
148
 
    foreach (my $i; $i < @bins; $i++)
149
 
      {
150
 
        $bins[$i] = ($bins[$i] - $mingc) / $scale;
151
 
      }
152
 
    $maxgc = int($maxgc * 100);
153
 
    $mingc = int($mingc * 100);
154
 
 
155
 
  }
156
 
 
157
 
# Calculate values that will be used in the layout
158
 
  
159
 
  push @bins,0.5 unless @bins;  # avoid div by zero
160
 
  my $bin_width  = ($x2-$x1)/@bins;
161
 
  my $bin_height = $y2-$y1;
162
 
  my $fgcolor    = $self->fgcolor;
163
 
  my $bgcolor    = $self->factory->translate_color($self->panel->gridcolor);
164
 
  my $axiscolor  = $self->color('axis_color') || $fgcolor;
165
 
 
166
 
# Draw the axes
167
 
  my $fontwidth = $self->font->width;
168
 
  $gd->line($x1,  $y1,        $x1,  $y2,        $axiscolor);
169
 
  $gd->line($x2-2,$y1,        $x2-2,$y2,        $axiscolor);
170
 
  $gd->line($x1,  $y1,        $x1+3,$y1,        $axiscolor);
171
 
  $gd->line($x1,  $y2,        $x1+3,$y2,        $axiscolor);
172
 
  $gd->line($x1,  ($y2+$y1)/2,$x1+3,($y2+$y1)/2,$axiscolor);
173
 
  $gd->line($x2-4,$y1,        $x2-1, $y1,       $axiscolor);
174
 
  $gd->line($x2-4,$y2,        $x2-1, $y2,       $axiscolor);
175
 
  $gd->line($x2-4,($y2+$y1)/2,$x2-1,($y2+$y1)/2,$axiscolor);
176
 
  $gd->line($x1+5,$y2,        $x2-5,$y2,        $bgcolor);
177
 
  $gd->line($x1+5,($y2+$y1)/2,$x2-5,($y2+$y1)/2,$bgcolor);
178
 
  $gd->line($x1+5,$y1,        $x2-5,$y1,        $bgcolor);
179
 
  $gd->string($self->font,$x1-length('% gc')*$fontwidth,$y1,'% gc',$axiscolor) if $bin_height > $self->font->height*2;
180
 
 
181
 
# If we are using a sliding window, the GC graph will be scaled to use the full
182
 
# height of the glyph, so label the right vertical axis to show the scaling that# is in effect
183
 
 
184
 
  $gd->string($self->font,$x2+3,$y1,"${maxgc}%",$axiscolor) 
185
 
    if $bin_height > $self->font->height*2.5;
186
 
  $gd->string($self->font,$x2+3,$y2-$self->font->height,"${mingc}%",$axiscolor) 
187
 
    if $bin_height > $self->font->height*2.5;
188
 
 
189
 
# Draw the GC content graph itself
190
 
 
191
 
  if ($gc_window)
192
 
  {
193
 
    my $graphwidth = $x2 - $x1;
194
 
    my $scale = $graphwidth / @datapoints;
195
 
    my $gc_window_width = $gc_window/2 * $self->panel->scale;
196
 
    for (my $i = 1; $i < @datapoints; $i++)
197
 
      {
198
 
        my $x = $i + $gc_window_width;
199
 
        my $xlo = $x1 + ($x - 1) * $scale;
200
 
        my $xhi = $x1 + $x * $scale;
201
 
        last if $xhi >= $self->panel->right-$gc_window_width;
202
 
        my $y = $y2 - ($bin_height*$datapoints[$i]);
203
 
        $gd->line($xlo, $y2 - ($bin_height*$datapoints[$i-1]), 
204
 
                  $xhi, $y, 
205
 
                  $fgcolor);
206
 
      }
207
 
  }
208
 
  else
209
 
  {
210
 
    for (my $i = 0; $i < @bins; $i++) 
211
 
      {
212
 
          my $bin_start  = $x1+$i*$bin_width;
213
 
          my $bin_stop   = $bin_start + $bin_width;
214
 
          my $y          = $y2 - ($bin_height*$bins[$i]);
215
 
          $gd->line($bin_start,$y,
216
 
                    $bin_stop,$y,
217
 
                    $fgcolor);
218
 
          $gd->line($bin_stop,$y,
219
 
                    $bin_stop,$y2 - ($bin_height*$bins[$i+1]),
220
 
                    $fgcolor)
221
 
              if $i < @bins-1;
222
 
      }
223
 
  }
224
 
}
225
 
 
226
 
sub make_key_feature {
227
 
  my $self = shift;
228
 
  my @gatc = qw(g a t c);
229
 
  my $offset = $self->panel->offset;
230
 
  my $scale = 1/$self->scale;  # base pairs/pixel
231
 
 
232
 
  my $start = $offset+1;
233
 
  my $stop  = $offset+100*$scale;
234
 
  my $feature =
235
 
    Bio::Graphics::Feature->new(-start=> $start,
236
 
                                -stop => $stop,
237
 
                                -seq  => join('',map{$gatc[rand 4]} (1..500)),
238
 
                                -name => $self->option('key'),
239
 
                                -strand => '+1',
240
 
                               );
241
 
  $feature;
242
 
}
243
 
 
244
 
1;
245
 
 
246
 
__END__
247
 
 
248
 
=head1 NAME
249
 
 
250
 
Bio::Graphics::Glyph::dna - The "dna" glyph
251
 
 
252
 
=head1 SYNOPSIS
253
 
 
254
 
  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
255
 
 
256
 
=head1 DESCRIPTION
257
 
 
258
 
This glyph draws DNA sequences.  At high magnifications, this glyph
259
 
will draw the actual base pairs of the sequence (both strands).  At
260
 
low magnifications, the glyph will plot the GC content.  By default,
261
 
the GC calculation will use non-overlapping bins, but this can be
262
 
changed by specifying the gc_window option, in which case, a 
263
 
sliding window calculation will be used.
264
 
 
265
 
For this glyph to work, the feature must return a DNA sequence string
266
 
in response to the dna() method.
267
 
 
268
 
=head2 OPTIONS
269
 
 
270
 
The following options are standard among all Glyphs.  See
271
 
L<Bio::Graphics::Glyph> for a full explanation.
272
 
 
273
 
  Option      Description                      Default
274
 
  ------      -----------                      -------
275
 
 
276
 
  -fgcolor      Foreground color               black
277
 
 
278
 
  -outlinecolor Synonym for -fgcolor
279
 
 
280
 
  -bgcolor      Background color               turquoise
281
 
 
282
 
  -fillcolor    Synonym for -bgcolor
283
 
 
284
 
  -linewidth    Line width                     1
285
 
 
286
 
  -height       Height of glyph                10
287
 
 
288
 
  -font         Glyph font                     gdSmallFont
289
 
 
290
 
  -connector    Connector type                 0 (false)
291
 
 
292
 
  -connector_color
293
 
                Connector color                black
294
 
 
295
 
  -label        Whether to draw a label        0 (false)
296
 
 
297
 
  -description  Whether to draw a description  0 (false)
298
 
 
299
 
  -hilite       Highlight color                undef (no color)
300
 
 
301
 
In addition to the common options, the following glyph-specific
302
 
options are recognized:
303
 
 
304
 
  Option      Description               Default
305
 
  ------      -----------               -------
306
 
 
307
 
  -do_gc      Whether to draw the GC      true
308
 
              graph at low mags
309
 
 
310
 
  -gc_window  Size of the sliding window  E<lt>noneE<gt>
311
 
              to use in the GC content 
312
 
              calculation.  If this is 
313
 
              not defined, non-
314
 
              overlapping bins will be 
315
 
              used. If this is set to
316
 
              "auto", then the glyph will
317
 
              choose a window equal to
318
 
              1% of the interval.
319
 
 
320
 
  -gc_bins    Fixed number of intervals   100
321
 
              to sample across the
322
 
              panel.
323
 
 
324
 
  -axis_color Color of the vertical axes  fgcolor
325
 
              in the GC content graph
326
 
 
327
 
  -strand      Show both forward and      auto
328
 
              reverse strand, one of
329
 
              "forward", "reverse",
330
 
              "both" or "auto".
331
 
              In "auto" mode,
332
 
              +1 strand features will
333
 
              show the plus strand
334
 
              -1 strand features will
335
 
              show the reverse complement
336
 
              and strandless features will
337
 
              show both
338
 
 
339
 
NOTE: -gc_window=E<gt>'auto' gives nice results and is recommended for
340
 
drawing GC content. The GC content axes draw slightly outside the
341
 
panel, so you may wish to add some extra padding on the right and
342
 
left.
343
 
 
344
 
=head1 BUGS
345
 
 
346
 
Please report them.
347
 
 
348
 
=head1 SEE ALSO
349
 
 
350
 
L<Bio::Graphics::Panel>,
351
 
L<Bio::Graphics::Glyph>,
352
 
L<Bio::Graphics::Glyph::arrow>,
353
 
L<Bio::Graphics::Glyph::cds>,
354
 
L<Bio::Graphics::Glyph::crossbox>,
355
 
L<Bio::Graphics::Glyph::diamond>,
356
 
L<Bio::Graphics::Glyph::dna>,
357
 
L<Bio::Graphics::Glyph::dot>,
358
 
L<Bio::Graphics::Glyph::ellipse>,
359
 
L<Bio::Graphics::Glyph::extending_arrow>,
360
 
L<Bio::Graphics::Glyph::generic>,
361
 
L<Bio::Graphics::Glyph::graded_segments>,
362
 
L<Bio::Graphics::Glyph::heterogeneous_segments>,
363
 
L<Bio::Graphics::Glyph::line>,
364
 
L<Bio::Graphics::Glyph::pinsertion>,
365
 
L<Bio::Graphics::Glyph::primers>,
366
 
L<Bio::Graphics::Glyph::rndrect>,
367
 
L<Bio::Graphics::Glyph::segments>,
368
 
L<Bio::Graphics::Glyph::ruler_arrow>,
369
 
L<Bio::Graphics::Glyph::toomany>,
370
 
L<Bio::Graphics::Glyph::transcript>,
371
 
L<Bio::Graphics::Glyph::transcript2>,
372
 
L<Bio::Graphics::Glyph::translation>,
373
 
L<Bio::Graphics::Glyph::triangle>,
374
 
L<Bio::DB::GFF>,
375
 
L<Bio::SeqI>,
376
 
L<Bio::SeqFeatureI>,
377
 
L<Bio::Das>,
378
 
L<GD>
379
 
 
380
 
=head1 AUTHOR
381
 
 
382
 
Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
383
 
 
384
 
Sliding window GC calculation added by Peter Ashton E<lt>pda@sanger.ac.ukE<gt>.
385
 
 
386
 
Copyright (c) 2001 Cold Spring Harbor Laboratory
387
 
 
388
 
This library is free software; you can redistribute it and/or modify
389
 
it under the same terms as Perl itself.  See DISCLAIMER.txt for
390
 
disclaimers of warranty.
391
 
 
392
 
=cut