|
0
|
1 package Bio::Graphics::Glyph::xyplot;
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use Bio::Graphics::Glyph::segments;
|
|
|
5 use vars '@ISA';
|
|
|
6 use GD 'gdTinyFont';
|
|
|
7
|
|
|
8 @ISA = 'Bio::Graphics::Glyph::segments';
|
|
|
9
|
|
|
10 use constant DEFAULT_POINT_RADIUS=>1;
|
|
|
11
|
|
|
12 my %SYMBOLS = (
|
|
|
13 triangle => \&draw_triangle,
|
|
|
14 square => \&draw_square,
|
|
|
15 disc => \&draw_disc,
|
|
|
16 point => \&draw_point,
|
|
|
17 );
|
|
|
18
|
|
|
19 sub point_radius {
|
|
|
20 shift->option('point_radius') || DEFAULT_POINT_RADIUS;
|
|
|
21 }
|
|
|
22
|
|
|
23 sub pad_top { 0 }
|
|
|
24
|
|
|
25 sub draw {
|
|
|
26 my $self = shift;
|
|
|
27 my ($gd,$dx,$dy) = @_;
|
|
|
28 my ($left,$top,$right,$bottom) = $self->calculate_boundaries($dx,$dy);
|
|
|
29
|
|
|
30 my @parts = $self->parts;
|
|
|
31 return $self->SUPER::draw(@_) unless @parts > 0;
|
|
|
32
|
|
|
33 # figure out the scale and such like
|
|
|
34 my $max_score = $self->option('max_score');
|
|
|
35 my $min_score = $self->option('min_score');
|
|
|
36
|
|
|
37 unless (defined $max_score && defined $min_score) {
|
|
|
38 my $first = $parts[0];
|
|
|
39 $max_score = $min_score = eval { $first->feature->score} || 0;
|
|
|
40 for my $part (@parts) {
|
|
|
41 my $s = eval { $part->feature->score };
|
|
|
42 next unless defined $s;
|
|
|
43 $max_score = $s if $s > $max_score;
|
|
|
44 $min_score = $s if $s < $min_score;
|
|
|
45 }
|
|
|
46 }
|
|
|
47
|
|
|
48 # if a scale is called for, then we adjust the max and min to be even
|
|
|
49 # multiples of a power of 10.
|
|
|
50 if ($self->option('scale')) {
|
|
|
51 $max_score = max10($max_score);
|
|
|
52 $min_score = min10($min_score);
|
|
|
53 }
|
|
|
54
|
|
|
55 my $height = $self->option('height');
|
|
|
56 my $scale = $max_score > $min_score ? $height/($max_score-$min_score)
|
|
|
57 : 1;
|
|
|
58 my $x = $dx;
|
|
|
59 my $y = $dy + $self->top + $self->pad_top;
|
|
|
60
|
|
|
61 # now seed all the parts with the information they need to draw their positions
|
|
|
62 foreach (@parts) {
|
|
|
63 my $s = eval {$_->feature->score};
|
|
|
64 next unless defined $s;
|
|
|
65 my $position = ($s-$min_score) * $scale;
|
|
|
66 $_->{_y_position} = $bottom - $position;
|
|
|
67 }
|
|
|
68
|
|
|
69 my $type = $self->option('graph_type');
|
|
|
70 $self->_draw_histogram($gd,$x,$y) if $type eq 'histogram';
|
|
|
71 $self->_draw_boxes($gd,$x,$y) if $type eq 'boxes';
|
|
|
72 $self->_draw_line ($gd,$x,$y) if $type eq 'line'
|
|
|
73 or $type eq 'linepoints';
|
|
|
74 $self->_draw_points($gd,$x,$y) if $type eq 'points'
|
|
|
75 or $type eq 'linepoints';
|
|
|
76
|
|
|
77 $self->_draw_scale($gd,$scale,$min_score,$max_score,$dx,$dy) if $self->option('scale');
|
|
|
78 }
|
|
|
79
|
|
|
80 sub log10 { log(shift)/log(10) }
|
|
|
81 sub max10 {
|
|
|
82 my $a = shift;
|
|
|
83 $a = 1 if $a <= 0;
|
|
|
84 my $l=int(log10($a));
|
|
|
85 $l = 10**$l;
|
|
|
86 my $r = $a/$l;
|
|
|
87 return $r*$l if int($r) == $r;
|
|
|
88 return $l*int(($a+$l)/$l);
|
|
|
89 }
|
|
|
90 sub min10 {
|
|
|
91 my $a = shift;
|
|
|
92 $a = 1 if $a <= 0;
|
|
|
93 my $l=int(log10($a));
|
|
|
94 $l = 10**$l;
|
|
|
95 my $r = $a/$l;
|
|
|
96 return $r*$l if int($r) == $r;
|
|
|
97 return $l*int($a/$l);
|
|
|
98 }
|
|
|
99
|
|
|
100 sub _draw_histogram {
|
|
|
101 my $self = shift;
|
|
|
102 my ($gd,$left,$top) = @_;
|
|
|
103
|
|
|
104 my @parts = $self->parts;
|
|
|
105 my $fgcolor = $self->fgcolor;
|
|
|
106
|
|
|
107 # draw each of the component lines of the histogram surface
|
|
|
108 for (my $i = 0; $i < @parts; $i++) {
|
|
|
109 my $part = $parts[$i];
|
|
|
110 my $next = $parts[$i+1];
|
|
|
111 my ($x1,$y1,$x2,$y2) = $part->calculate_boundaries($left,$top);
|
|
|
112 $gd->line($x1,$part->{_y_position},$x2,$part->{_y_position},$fgcolor);
|
|
|
113 next unless $next;
|
|
|
114 my ($x3,$y3,$x4,$y4) = $next->calculate_boundaries($left,$top);
|
|
|
115 if ($x2 == $x3) {# connect vertically to next level
|
|
|
116 $gd->line($x2,$part->{_y_position},$x2,$next->{_y_position},$fgcolor);
|
|
|
117 } else {
|
|
|
118 $gd->line($x2,$part->{_y_position},$x2,$y2,$fgcolor); # to bottom
|
|
|
119 $gd->line($x2,$y2,$x3,$y2,$fgcolor); # to right
|
|
|
120 $gd->line($x3,$y4,$x3,$next->{_y_position},$fgcolor); # up
|
|
|
121 }
|
|
|
122 }
|
|
|
123
|
|
|
124 # end points: from bottom to first
|
|
|
125 my ($x1,$y1,$x2,$y2) = $parts[0]->calculate_boundaries($left,$top);
|
|
|
126 $gd->line($x1,$y2,$x1,$parts[0]->{_y_position},$fgcolor);
|
|
|
127 # from last to bottom
|
|
|
128 my ($x3,$y3,$x4,$y4) = $parts[-1]->calculate_boundaries($left,$top);
|
|
|
129 $gd->line($x4,$parts[-1]->{_y_position},$x4,$y4,$fgcolor);
|
|
|
130
|
|
|
131 # from left to right -- don't like this
|
|
|
132 # $gd->line($x1,$y2,$x4,$y4,$fgcolor);
|
|
|
133
|
|
|
134 # That's it. Not too hard.
|
|
|
135 }
|
|
|
136
|
|
|
137 sub _draw_boxes {
|
|
|
138 my $self = shift;
|
|
|
139 my ($gd,$left,$top) = @_;
|
|
|
140
|
|
|
141 my @parts = $self->parts;
|
|
|
142 my $fgcolor = $self->fgcolor;
|
|
|
143 my $bgcolor = $self->bgcolor;
|
|
|
144 my $height = $self->height;
|
|
|
145
|
|
|
146 # draw each of the component lines of the histogram surface
|
|
|
147 for (my $i = 0; $i < @parts; $i++) {
|
|
|
148 my $part = $parts[$i];
|
|
|
149 my $next = $parts[$i+1];
|
|
|
150 my ($x1,$y1,$x2,$y2) = $part->calculate_boundaries($left,$top);
|
|
|
151 $self->filled_box($gd,$x1,$part->{_y_position},$x2,$y2,$bgcolor,$fgcolor);
|
|
|
152 next unless $next;
|
|
|
153 my ($x3,$y3,$x4,$y4) = $next->calculate_boundaries($left,$top);
|
|
|
154 $gd->line($x2,$y2,$x3,$y4,$fgcolor) if $x2 < $x3;
|
|
|
155 }
|
|
|
156
|
|
|
157 # That's it.
|
|
|
158 }
|
|
|
159
|
|
|
160 sub _draw_line {
|
|
|
161 my $self = shift;
|
|
|
162 my ($gd,$left,$top) = @_;
|
|
|
163
|
|
|
164 my @parts = $self->parts;
|
|
|
165 my $fgcolor = $self->fgcolor;
|
|
|
166 my $bgcolor = $self->bgcolor;
|
|
|
167
|
|
|
168 # connect to center positions of each interval
|
|
|
169 my $first_part = shift @parts;
|
|
|
170 my ($x1,$y1,$x2,$y2) = $first_part->calculate_boundaries($left,$top);
|
|
|
171 my $current_x = ($x1+$x2)/2;
|
|
|
172 my $current_y = $first_part->{_y_position};
|
|
|
173
|
|
|
174 for my $part (@parts) {
|
|
|
175 my ($x1,$y1,$x2,$y2) = $part->calculate_boundaries($left,$top);
|
|
|
176 my $next_x = ($x1+$x2)/2;
|
|
|
177 my $next_y = $part->{_y_position};
|
|
|
178 $gd->line($current_x,$current_y,$next_x,$next_y,$fgcolor);
|
|
|
179 ($current_x,$current_y) = ($next_x,$next_y);
|
|
|
180 }
|
|
|
181
|
|
|
182 }
|
|
|
183
|
|
|
184 sub _draw_points {
|
|
|
185 my $self = shift;
|
|
|
186 my ($gd,$left,$top) = @_;
|
|
|
187 my $symbol_name = $self->option('point_symbol') || 'point';
|
|
|
188 my $symbol_ref = $SYMBOLS{$symbol_name};
|
|
|
189
|
|
|
190 my @parts = $self->parts;
|
|
|
191 my $bgcolor = $self->bgcolor;
|
|
|
192 my $pr = $self->point_radius;
|
|
|
193
|
|
|
194 for my $part (@parts) {
|
|
|
195 my ($x1,$y1,$x2,$y2) = $part->calculate_boundaries($left,$top);
|
|
|
196 my $x = ($x1+$x2)/2;
|
|
|
197 my $y = $part->{_y_position};
|
|
|
198 $symbol_ref->($gd,$x,$y,$pr,$bgcolor);
|
|
|
199 }
|
|
|
200 }
|
|
|
201
|
|
|
202 sub _draw_scale {
|
|
|
203 my $self = shift;
|
|
|
204 my ($gd,$scale,$min,$max,$dx,$dy) = @_;
|
|
|
205 my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries($dx,$dy);
|
|
|
206
|
|
|
207 my $side = $self->option('scale');
|
|
|
208 return if $side eq 'none';
|
|
|
209 $side ||= 'both';
|
|
|
210
|
|
|
211 my $fg = $self->fgcolor;
|
|
|
212 my $half = ($y1+$y2)/2;
|
|
|
213
|
|
|
214 $gd->line($x1+1,$y1,$x1+1,$y2,$fg) if $side eq 'left' || $side eq 'both';
|
|
|
215 $gd->line($x2-2,$y1,$x2-2,$y2,$fg) if $side eq 'right' || $side eq 'both';
|
|
|
216
|
|
|
217 for ([$y1,$max],[$half,int(($max-$min)/2+0.5)]) {
|
|
|
218 $gd->line($x1,$_->[0],$x1+3,$_->[0],$fg) if $side eq 'left' || $side eq 'both';
|
|
|
219 $gd->line($x2-4,$_->[0],$x2,$_->[0],$fg) if $side eq 'right' || $side eq 'both';
|
|
|
220 if ($side eq 'left' or $side eq 'both') {
|
|
|
221 $gd->string(gdTinyFont,
|
|
|
222 $x1 + 5,$_->[0]-(gdTinyFont->height/3),
|
|
|
223 $_->[1],
|
|
|
224 $fg);
|
|
|
225 }
|
|
|
226 if ($side eq 'right' or $side eq 'both') {
|
|
|
227 $gd->string(gdTinyFont,
|
|
|
228 $x2-5 - (length($_->[1])*gdTinyFont->width),$_->[0]-(gdTinyFont->height/3),
|
|
|
229 $_->[1],
|
|
|
230 $fg);
|
|
|
231 }
|
|
|
232 }
|
|
|
233 }
|
|
|
234
|
|
|
235 # we are unbumpable!
|
|
|
236 sub bump {
|
|
|
237 return 0;
|
|
|
238 }
|
|
|
239
|
|
|
240 sub connector {
|
|
|
241 my $self = shift;
|
|
|
242 my $type = $self->option('graph_type');
|
|
|
243 return 1 if $type eq 'line' or $type eq 'linepoints';
|
|
|
244 }
|
|
|
245
|
|
|
246 sub height {
|
|
|
247 my $self = shift;
|
|
|
248 return $self->option('graph_height') || $self->SUPER::height;
|
|
|
249 }
|
|
|
250
|
|
|
251 sub draw_triangle {
|
|
|
252 my ($gd,$x,$y,$pr,$color) = @_;
|
|
|
253 my ($vx1,$vy1) = ($x-$pr,$y+$pr);
|
|
|
254 my ($vx2,$vy2) = ($x, $y-$pr);
|
|
|
255 my ($vx3,$vy3) = ($x+$pr,$y+$pr);
|
|
|
256 $gd->line($vx1,$vy1,$vx2,$vy2,$color);
|
|
|
257 $gd->line($vx2,$vy2,$vx3,$vy3,$color);
|
|
|
258 $gd->line($vx3,$vy3,$vx1,$vy1,$color);
|
|
|
259 }
|
|
|
260 sub draw_square {
|
|
|
261 my ($gd,$x,$y,$pr,$color) = @_;
|
|
|
262 $gd->line($x-$pr,$y-$pr,$x+$pr,$y-$pr,$color);
|
|
|
263 $gd->line($x+$pr,$y-$pr,$x+$pr,$y+$pr,$color);
|
|
|
264 $gd->line($x+$pr,$y+$pr,$x-$pr,$y+$pr,$color);
|
|
|
265 $gd->line($x-$pr,$y+$pr,$x-$pr,$y-$pr,$color);
|
|
|
266 }
|
|
|
267 sub draw_disc {
|
|
|
268 my ($gd,$x,$y,$pr,$color) = @_;
|
|
|
269 $gd->arc($x,$y,$pr,$pr,0,360,$color);
|
|
|
270 }
|
|
|
271 sub draw_point {
|
|
|
272 my ($gd,$x,$y,$pr,$color) = @_;
|
|
|
273 $gd->setPixel($x,$y,$color);
|
|
|
274 }
|
|
|
275
|
|
|
276 sub _subseq {
|
|
|
277 my $class = shift;
|
|
|
278 my $feature = shift;
|
|
|
279 return $feature->segments if $feature->can('segments');
|
|
|
280 my @split = eval { my $id = $feature->location->seq_id;
|
|
|
281 my @subs = $feature->location->sub_Location;
|
|
|
282 grep {$id eq $_->seq_id} @subs};
|
|
|
283 return @split if @split;
|
|
|
284 return $feature->sub_SeqFeature if $feature->can('sub_SeqFeature');
|
|
|
285 return;
|
|
|
286 }
|
|
|
287
|
|
|
288 sub keyglyph {
|
|
|
289 my $self = shift;
|
|
|
290
|
|
|
291 my $scale = 1/$self->scale; # base pairs/pixel
|
|
|
292
|
|
|
293 my $feature =
|
|
|
294 Bio::Graphics::Feature->new(
|
|
|
295 -segments=>[ [ 0*$scale,9*$scale],
|
|
|
296 [ 10*$scale,19*$scale],
|
|
|
297 [ 20*$scale, 29*$scale]
|
|
|
298 ],
|
|
|
299 -name => 'foo bar',
|
|
|
300 -strand => '+1');
|
|
|
301 ($feature->segments)[0]->score(10);
|
|
|
302 ($feature->segments)[1]->score(50);
|
|
|
303 ($feature->segments)[2]->score(25);
|
|
|
304 my $factory = $self->factory->clone;
|
|
|
305 $factory->set_option(label => 1);
|
|
|
306 $factory->set_option(bump => 0);
|
|
|
307 $factory->set_option(connector => 'solid');
|
|
|
308 my $glyph = $factory->make_glyph(0,$feature);
|
|
|
309 return $glyph;
|
|
|
310 }
|
|
|
311
|
|
|
312
|
|
|
313 1;
|
|
|
314
|
|
|
315 __END__
|
|
|
316
|
|
|
317 =head1 NAME
|
|
|
318
|
|
|
319 Bio::Graphics::Glyph::xyplot - The xyplot glyph
|
|
|
320
|
|
|
321 =head1 SYNOPSIS
|
|
|
322
|
|
|
323 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
|
324
|
|
|
325 =head1 DESCRIPTION
|
|
|
326
|
|
|
327 This glyph is used for drawing features that have a position on the
|
|
|
328 genome and a numeric value. It can be used to represent gene
|
|
|
329 prediction scores, motif-calling scores, percent similarity,
|
|
|
330 microarray intensities, or other features that require a line plot.
|
|
|
331
|
|
|
332 The X axis represents the position on the genome, as per all other
|
|
|
333 glyphs. The Y axis represents the score. Options allow you to set
|
|
|
334 the height of the glyph, the maximum and minimum scores, the color of
|
|
|
335 the line and axis, and the symbol to draw.
|
|
|
336
|
|
|
337 The plot is designed to work on a single feature group that contains
|
|
|
338 subfeatures. It is the subfeatures that carry the score
|
|
|
339 information. The best way to arrange for this is to create an
|
|
|
340 aggregator for the feature. We'll take as an example a histogram of
|
|
|
341 repeat density in which interval are spaced every megabase and the
|
|
|
342 score indicates the number of repeats in the interval; we'll assume
|
|
|
343 that the database has been loaded in in such a way that each interval
|
|
|
344 is a distinct feature with the method name "density" and the source
|
|
|
345 name "repeat". Furthermore, all the repeat features are grouped
|
|
|
346 together into a single group (the name of the group is irrelevant).
|
|
|
347 If you are using Bio::DB::GFF and Bio::Graphics directly, the sequence
|
|
|
348 of events would look like this:
|
|
|
349
|
|
|
350 my $agg = Bio::DB::GFF::Aggregator->new(-method => 'repeat_density',
|
|
|
351 -sub_parts => 'density:repeat');
|
|
|
352 my $db = Bio::DB::GFF->new(-dsn=>'my_database',
|
|
|
353 -aggregators => $agg);
|
|
|
354 my $segment = $db->segment('Chr1');
|
|
|
355 my @features = $segment->features('repeat_density');
|
|
|
356
|
|
|
357 my $panel = Bio::Graphics::Panel->new;
|
|
|
358 $panel->add_track(\@features,
|
|
|
359 -glyph => 'xyplot');
|
|
|
360
|
|
|
361 If you are using Generic Genome Browser, you will add this to the
|
|
|
362 configuration file:
|
|
|
363
|
|
|
364 aggregators = repeat_density{density:repeat}
|
|
|
365 clone alignment etc
|
|
|
366
|
|
|
367 =head2 OPTIONS
|
|
|
368
|
|
|
369 The following options are standard among all Glyphs. See
|
|
|
370 L<Bio::Graphics::Glyph> for a full explanation.
|
|
|
371
|
|
|
372 Option Description Default
|
|
|
373 ------ ----------- -------
|
|
|
374
|
|
|
375 -fgcolor Foreground color black
|
|
|
376
|
|
|
377 -outlinecolor Synonym for -fgcolor
|
|
|
378
|
|
|
379 -bgcolor Background color turquoise
|
|
|
380
|
|
|
381 -fillcolor Synonym for -bgcolor
|
|
|
382
|
|
|
383 -linewidth Line width 1
|
|
|
384
|
|
|
385 -height Height of glyph 10
|
|
|
386
|
|
|
387 -font Glyph font gdSmallFont
|
|
|
388
|
|
|
389 -label Whether to draw a label 0 (false)
|
|
|
390
|
|
|
391 -description Whether to draw a description 0 (false)
|
|
|
392
|
|
|
393 In addition, the alignment glyph recognizes the following
|
|
|
394 glyph-specific options:
|
|
|
395
|
|
|
396 Option Description Default
|
|
|
397 ------ ----------- -------
|
|
|
398
|
|
|
399 -max_score Maximum value of the Calculated
|
|
|
400 feature's "score" attribute
|
|
|
401
|
|
|
402 -min_score Minimum value of the Calculated
|
|
|
403 feature's "score" attribute
|
|
|
404
|
|
|
405 -graph_type Type of graph to generate. Histogram
|
|
|
406 Options are: "histogram",
|
|
|
407 "boxes", "line", "points",
|
|
|
408 or "linepoints".
|
|
|
409
|
|
|
410 -point_symbol Symbol to use. Options are none
|
|
|
411 "triangle", "square", "disc",
|
|
|
412 "point", and "none".
|
|
|
413
|
|
|
414 -point_radius Radius of the symbol, in 1
|
|
|
415 pixels
|
|
|
416
|
|
|
417 -scale Position where the Y axis none
|
|
|
418 scale is drawn if any.
|
|
|
419 It should be one of
|
|
|
420 "left", "right" or "none"
|
|
|
421
|
|
|
422 -graph_height Specify height of the graph Same as the
|
|
|
423 "height" option.
|
|
|
424
|
|
|
425 =head1 BUGS
|
|
|
426
|
|
|
427 Please report them.
|
|
|
428
|
|
|
429 =head1 SEE ALSO
|
|
|
430
|
|
|
431 L<Bio::Graphics::Panel>,
|
|
|
432 L<Bio::Graphics::Track>,
|
|
|
433 L<Bio::Graphics::Glyph::transcript2>,
|
|
|
434 L<Bio::Graphics::Glyph::anchored_arrow>,
|
|
|
435 L<Bio::Graphics::Glyph::arrow>,
|
|
|
436 L<Bio::Graphics::Glyph::box>,
|
|
|
437 L<Bio::Graphics::Glyph::primers>,
|
|
|
438 L<Bio::Graphics::Glyph::segments>,
|
|
|
439 L<Bio::Graphics::Glyph::toomany>,
|
|
|
440 L<Bio::Graphics::Glyph::transcript>,
|
|
|
441
|
|
|
442 =head1 AUTHOR
|
|
|
443
|
|
|
444 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
|
|
|
445
|
|
|
446 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
|
447
|
|
|
448 This library is free software; you can redistribute it and/or modify
|
|
|
449 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
|
450 disclaimers of warranty.
|
|
|
451
|
|
|
452 =cut
|
|
|
453
|
