changes from Patrick + manifest update
[imager-graph.git] / lib / Imager / Graph / Vertical.pm
CommitLineData
2eac77fc 1package Imager::Graph::Vertical;
2
3=head1 NAME
4
5 Imager::Graph::Vertical- A super class for line/bar/column charts
6
7=cut
8
9use strict;
10use vars qw(@ISA);
11use Imager::Graph;
12@ISA = qw(Imager::Graph);
13
14=over 4
15
16=item add_data_series(\@data, $series_name)
17
18Add a data series to the graph, of the default type.
19
20=cut
21
22sub add_data_series {
23 my $self = shift;
24 my $data_ref = shift;
25 my $series_name = shift;
26
27 my $series_type = $self->_get_default_series_type();
28 $self->_add_data_series($series_type, $data_ref, $series_name);
29
30 return;
31}
32
33=item add_column_data_series(\@data, $series_name)
34
35Add a column data series to the graph.
36
37=cut
38
39sub add_column_data_series {
40 my $self = shift;
41 my $data_ref = shift;
42 my $series_name = shift;
43
44 $self->_add_data_series('column', $data_ref, $series_name);
45
46 return;
47}
48
49=item add_stacked_column_data_series(\@data, $series_name)
50
51Add a stacked column data series to the graph.
52
53=cut
54
55sub add_stacked_column_data_series {
56 my $self = shift;
57 my $data_ref = shift;
58 my $series_name = shift;
59
60 $self->_add_data_series('stacked_column', $data_ref, $series_name);
61
62 return;
63}
64
65=item add_line_data_series(\@data, $series_name)
66
67Add a line data series to the graph.
68
69=cut
70
71sub add_line_data_series {
72 my $self = shift;
73 my $data_ref = shift;
74 my $series_name = shift;
75
76 $self->_add_data_series('line', $data_ref, $series_name);
77
78 return;
79}
80
81=item set_range_padding($percentage)
82
83Sets the padding to be used, as a percentage. For example, if your data ranges from 0 to 10, and you have a 20 percent padding, the y axis will go to 12.
84
85Defaults to 10.
86
87=cut
88
89sub set_range_padding {
90 $_[0]->{'custom_style'}->{'range_padding'} = $_[1];
91}
92
93=item draw()
94
95Draw the graph
96
97=cut
98
99sub draw {
100 my ($self, %opts) = @_;
101
102 if (!$self->_valid_input()) {
103 return;
104 }
105
106 $self->_style_setup(\%opts);
107
108 my $style = $self->{_style};
109
110 my $img = $self->_get_image()
111 or return;
112
113 my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
114 $self->_set_image_box(\@image_box);
115
116 # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
117 $self->_get_data_range();
118 my $column_count = $self->_get_column_count();
119
120 my $width = $self->_get_number('width');
121 my $height = $self->_get_number('height');
122 my $size = $self->_get_number('size');
123
124 my $bottom = ($height - $size) / 2;
125 my $left = ($width - $size) / 2;
126
127 my $col_width = int($size / $column_count) -1;
128 my $graph_width = $col_width * $column_count + 1;
129
130 my @graph_box = ( $left, $bottom, $left + $graph_width - 1, $bottom + $size - 1 );
131 $self->_set_graph_box(\@graph_box);
132
133 $self->_draw_legend();
134
135 $img->box(
136 color => $self->_get_color('outline.line'),
137 xmin => $left,
138 xmax => $left+$graph_width,
139 ymin => $bottom,
140 ymax => $bottom+$size,
141 );
142
143 $img->box(
144 color => $self->_get_color('bg'),
145 xmin => $left + 1,
146 xmax => $left+$graph_width - 1,
147 ymin => $bottom + 1,
148 ymax => $bottom+$size -1 ,
149 filled => 1,
150 );
151
152 my $min_value = $self->_get_min_value();
153 my $max_value = $self->_get_max_value();
154 my $value_range = $max_value - $min_value;
155
156 my $zero_position;
157 if ($value_range) {
158 $zero_position = $bottom + $size - (-1*$min_value / $value_range) * ($size -1);
159 }
160
161 if ($min_value < 0) {
162 $img->box(
163 color => $self->_get_color('negative_bg'),
164 xmin => $left + 1,
165 xmax => $left+$graph_width- 1,
166 ymin => $zero_position,
167 ymax => $bottom+$size -1,
168 filled => 1,
169 );
170 $img->line(
171 x1 => $left+1,
172 y1 => $zero_position,
173 x2 => $left + $graph_width,
174 y2 => $zero_position,
175 color => $self->_get_color('outline.line'),
176 );
177 }
178
179 if ($self->_get_data_series()->{'stacked_column'}) {
180 $self->_draw_stacked_columns();
181 }
182 if ($self->_get_data_series()->{'column'}) {
183 $self->_draw_columns();
184 }
185 if ($self->_get_data_series()->{'line'}) {
186 $self->_draw_lines();
187 }
188 return $self->_get_image();
189}
190
191sub _get_data_range {
192 my $self = shift;
193
194 my $max_value = 0;
195 my $min_value = 0;
196 my $column_count = 0;
197
198 my ($sc_min, $sc_max, $sc_cols) = $self->_get_stacked_column_range();
199 my ($c_min, $c_max, $c_cols) = $self->_get_column_range();
200 my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
201
202 # These are side by side...
203 $sc_cols += $c_cols;
204
205 $min_value = $self->_min(0, $sc_min, $c_min, $l_min);
206 $max_value = $self->_max(0, $sc_max, $c_max, $l_max);
207
208 my $range_padding = $self->_get_number('range_padding');
209 if (!defined $range_padding) {
210 $range_padding = 10;
211 }
212 if ($range_padding && $min_value < 0) {
213 my $difference = $min_value * $range_padding / 100;
214 if ($min_value < -1 && $difference > -1) {
215 $difference = -1;
216 }
217 $min_value += $difference;
218 }
219 if ($range_padding && $max_value > 0) {
220 my $difference = $max_value * $range_padding / 100;
221 if ($max_value > 1 && $difference < 1) {
222 $difference = 1;
223 }
224 $max_value += $difference;
225 }
226
227 $column_count = $self->_max(0, $sc_cols, $l_cols);
228
229 $self->_set_max_value($max_value);
230 $self->_set_min_value($min_value);
231 $self->_set_column_count($column_count);
232}
233
234sub _min {
235 my $self = shift;
236 my $min = shift;
237
238 foreach my $value (@_) {
239 if ($value < $min) { $min = $value; }
240 }
241 return $min;
242}
243
244sub _max {
245 my $self = shift;
246 my $min = shift;
247
248 foreach my $value (@_) {
249 if ($value > $min) { $min = $value; }
250 }
251 return $min;
252}
253
254sub _get_line_range {
255 my $self = shift;
256 my $series = $self->_get_data_series()->{'line'};
257 return (0, 0, 0) unless $series;
258
259 my $max_value = 0;
260 my $min_value = 0;
261 my $column_count = 0;
262
263 my @series = @{$series};
264 foreach my $series (@series) {
265 my @data = @{$series->{'data'}};
266
267 if (scalar @data > $column_count) {
268 $column_count = scalar @data;
269 }
270
271 foreach my $value (@data) {
272 if ($value > $max_value) { $max_value = $value; }
273 if ($value < $min_value) { $min_value = $value; }
274 }
275 }
276
277 return ($min_value, $max_value, $column_count);
278}
279
280sub _get_column_range {
281 my $self = shift;
282
283 my $series = $self->_get_data_series()->{'column'};
284 return (0, 0, 0) unless $series;
285
286 my $max_value = 0;
287 my $min_value = 0;
288 my $column_count = 0;
289
290 my @series = @{$series};
291 foreach my $series (@series) {
292 my @data = @{$series->{'data'}};
293
294 foreach my $value (@data) {
295 $column_count++;
296 if ($value > $max_value) { $max_value = $value; }
297 if ($value < $min_value) { $min_value = $value; }
298 }
299 }
300
301 return ($min_value, $max_value, $column_count);
302}
303
304sub _get_stacked_column_range {
305 my $self = shift;
306
307 my $max_value = 0;
308 my $min_value = 0;
309 my $column_count = 0;
310
311 return (0, 0, 0) unless $self->_get_data_series()->{'stacked_column'};
312 my @series = @{$self->_get_data_series()->{'stacked_column'}};
313
314 my @max_entries;
315 my @min_entries;
316 for (my $i = scalar @series - 1; $i >= 0; $i--) {
317 my $series = $series[$i];
318 my $data = $series->{'data'};
319
320 for (my $i = 0; $i < scalar @$data; $i++) {
321 my $value = 0;
322 if ($data->[$i] > 0) {
323 $value = $data->[$i] + ($max_entries[$i] || 0);
324 $data->[$i] = $value;
325 $max_entries[$i] = $value;
326 }
327 elsif ($data->[$i] < 0) {
328 $value = $data->[$i] + ($min_entries[$i] || 0);
329 $data->[$i] = $value;
330 $min_entries[$i] = $value;
331 }
332 if ($value > $max_value) { $max_value = $value; }
333 if ($value < $min_value) { $min_value = $value; }
334 }
335 if (scalar @$data > $column_count) {
336 $column_count = scalar @$data;
337 }
338 }
339
340 return ($min_value, $max_value, $column_count);
341}
342
343sub _draw_legend {
344 my $self = shift;
345 my $style = $self->{'_style'};
346
347 my @labels;
348 my $img = $self->_get_image();
349 if (my $series = $self->_get_data_series()->{'stacked_column'}) {
350 push @labels, map { $_->{'series_name'} } @$series;
351 }
352 if (my $series = $self->_get_data_series()->{'column'}) {
353 push @labels, map { $_->{'series_name'} } @$series;
354 }
355 if (my $series = $self->_get_data_series()->{'line'}) {
356 push @labels, map { $_->{'series_name'} } @$series;
357 }
358
359 if ($style->{features}{legend} && (scalar @labels)) {
360 $self->SUPER::_draw_legend($self->_get_image(), \@labels, $self->_get_image_box())
361 or return;
362 }
363 return;
364}
365
366sub _draw_flat_legend {
367 return 1;
368}
369
370sub _draw_lines {
371 my $self = shift;
372 my $style = $self->{'_style'};
373
374 my $img = $self->_get_image();
375
376 my $max_value = $self->_get_max_value();
377 my $min_value = $self->_get_min_value();
378 my $column_count = $self->_get_column_count();
379
380 my $value_range = $max_value - $min_value;
381
382 my $width = $self->_get_number('width');
383 my $height = $self->_get_number('height');
384 my $size = $self->_get_number('size');
385
386 my $bottom = ($height - $size) / 2;
387 my $left = ($width - $size) / 2;
388
389 my $zero_position = $bottom + $size - (-1*$min_value / $value_range) * ($size -1);
390
391 if ($self->_get_y_tics()) {
392 $self->_draw_y_tics();
393 }
394 if ($self->_get_labels()) {
395 $self->_draw_x_tics();
396 }
397
398 my $line_series = $self->_get_data_series()->{'line'};
399 my $series_counter = $self->_get_series_counter() || 0;
400
401 my $has_columns = (defined $self->_get_data_series()->{'column'} || $self->_get_data_series->{'stacked_column'}) ? 1 : 0;
402
403 my $col_width = int($size / $column_count) -1;
404 my $graph_width = $col_width * $column_count + 1;
405
406 foreach my $series (@$line_series) {
407 my @data = @{$series->{'data'}};
408 my $data_size = scalar @data;
409
410 my $interval;
411 if ($has_columns) {
412 $interval = $graph_width / ($data_size);
413 }
414 else {
415 $interval = $graph_width / ($data_size - 1);
416 }
417 my @fill = $self->_data_fill($series_counter, $self->_get_graph_box());
418 my $color = $self->_data_color($series_counter);
419 for (my $i = 0; $i < $data_size - 1; $i++) {
420 my $x1 = $left + $i * $interval;
421 my $x2 = $left + ($i + 1) * $interval;
422
423 $x1 += $has_columns * $interval / 2;
424 $x2 += $has_columns * $interval / 2;
425
426 my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size;
427 my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $size;
428
429 $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => 1, color => $color) || die $img->errstr;
430 $img->circle(x => $x1, y => $y1, r => 3, aa => 1, filled => 1, @fill);
431 }
432
433 my $x2 = $left + ($data_size - 1) * $interval;
434 $x2 += $has_columns * $interval / 2;
435
436 my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $size;
437
438 $img->circle(x => $x2, y => $y2, r => 3, aa => 1, filled => 1, @fill);
439 $series_counter++;
440 }
441
442 $self->_set_series_counter($series_counter);
443 return;
444}
445
446sub _draw_columns {
447 my $self = shift;
448 my $style = $self->{'_style'};
449
450 my $img = $self->_get_image();
451
452 my $max_value = $self->_get_max_value();
453 my $min_value = $self->_get_min_value();
454 my $column_count = $self->_get_column_count();
455
456 my $value_range = $max_value - $min_value;
457
458 my $width = $self->_get_number('width');
459 my $height = $self->_get_number('height');
460 my $size = $self->_get_number('size');
461
462 my $bottom = ($height - $size) / 2;
463 my $left = ($width - $size) / 2 + 1;
464
465 my $zero_position = int($bottom + $size - (-1*$min_value / $value_range) * ($size -1));
466
467 if ($self->_get_y_tics()) {
468 $self->_draw_y_tics();
469 }
470 if ($self->_get_labels()) {
471 $self->_draw_x_tics();
472 }
473
474 my $bar_width = int(($size)/ $column_count - 2);
475
476 my $outline_color;
477 if ($style->{'features'}{'outline'}) {
478 $outline_color = $self->_get_color('outline.line');
479 }
480
481 my $series_counter = $self->_get_series_counter() || 0;
482 my $col_series = $self->_get_data_series()->{'column'};
483
484 # This tracks the series we're in relative to the starting series - this way colors stay accurate, but the columns don't start out too far to the right.
485 my $column_series = 0;
486
487 # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
488 my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
489
490 for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
491 my $series = $col_series->[$series_pos];
492 my @data = @{$series->{'data'}};
493 my $data_size = scalar @data;
494 my $color = $self->_data_color($series_counter);
495 for (my $i = 0; $i < $data_size; $i++) {
496 my $x1 = int($left + $bar_width * (scalar @$col_series * $i + $series_pos)) + scalar @$col_series * $i + $series_pos;
497 if ($has_stacked_columns) {
498 $x1 += ($i + 1) * $bar_width + $i + 1;
499 }
500 my $x2 = $x1 + $bar_width;
501
502 my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size);
503
504 my $color = $self->_data_color($series_counter);
505
506 # my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position]);
507 if ($data[$i] > 0) {
508 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, color => $color, filled => 1);
509 if ($style->{'features'}{'outline'}) {
510 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
511 }
512 }
513 else {
514 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, color => $color, filled => 1);
515 if ($style->{'features'}{'outline'}) {
516 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
517 }
518 }
519 }
520
521 $series_counter++;
522 $column_series++;
523 }
524 $self->_set_series_counter($series_counter);
525 return;
526}
527
528sub _draw_stacked_columns {
529 my $self = shift;
530 my $style = $self->{'_style'};
531
532 my $img = $self->_get_image();
533
534 my $max_value = $self->_get_max_value();
535 my $min_value = $self->_get_min_value();
536 my $column_count = $self->_get_column_count();
537 my $value_range = $max_value - $min_value;
538
539 my $graph_box = $self->_get_graph_box();
540 my $left = $graph_box->[0] + 1;
541 my $bottom = $graph_box->[1];
542 my $size = $self->_get_number('size');
543
544 if ($self->_get_y_tics()) {
545 $self->_draw_y_tics();
546 }
547 if ($self->_get_labels()) {
548 $self->_draw_x_tics();
549 }
550
551 my $bar_width = int($size / $column_count -2);
552 my $column_series = 0;
553 if (my $column_series_data = $self->_get_data_series()->{'column'}) {
554 $column_series = (scalar @$column_series_data);
555 }
556 $column_series++;
557
558 my $outline_color;
559 if ($style->{'features'}{'outline'}) {
560 $outline_color = $self->_get_color('outline.line');
561 }
562
563 my $zero_position = $bottom + $size - (-1*$min_value / $value_range) * ($size -1);
564 my $col_series = $self->_get_data_series()->{'stacked_column'};
565 my $series_counter = $self->_get_series_counter() || 0;
566 foreach my $series (@$col_series) {
567 my @data = @{$series->{'data'}};
568 my $data_size = scalar @data;
569 my $color = $self->_data_color($series_counter);
570 for (my $i = 0; $i < $data_size; $i++) {
571 my $x1 = int($left + $bar_width * ($column_series * $i)) + $column_series * $i;
572# my $x1 = $left + $i * $size / ($data_size);
573 my $x2 = $x1 + $bar_width;
574
575 my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size;
576
577 if ($data[$i] > 0) {
578 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, color => $color, filled => 1);
579 if ($style->{'features'}{'outline'}) {
580 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
581 }
582 }
583 else {
584 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, color => $color, filled => 1);
585 if ($style->{'features'}{'outline'}) {
586 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
587 }
588 }
589 }
590
591 $series_counter++;
592 }
593 $self->_set_series_counter($series_counter);
594 return;
595}
596
597sub _add_data_series {
598 my $self = shift;
599 my $series_type = shift;
600 my $data_ref = shift;
601 my $series_name = shift;
602
603 my $graph_data = $self->{'graph_data'} || {};
604
605 my $series = $graph_data->{$series_type} || [];
606
607 push @$series, { data => $data_ref, series_name => $series_name };
608
609 $graph_data->{$series_type} = $series;
610
611 $self->{'graph_data'} = $graph_data;
612 return;
613}
614
615=over
616
617=item set_y_tics($count)
618
619Set the number of Y tics to use. Their value and position will be determined by the data range.
620
621=cut
622
623sub set_y_tics {
624 $_[0]->{'y_tics'} = $_[1];
625}
626
627sub _get_y_tics {
628 return $_[0]->{'y_tics'};
629}
630
631sub _draw_y_tics {
632 my $self = shift;
633 my $min = $self->_get_min_value();
634 my $max = $self->_get_max_value();
635 my $tic_count = $self->_get_y_tics();
636
637 my $img = $self->_get_image();
638 my $graph_box = $self->_get_graph_box();
639 my $image_box = $self->_get_image_box();
640
641 my $interval = ($max - $min) / ($tic_count - 1);
642
643 my %text_info = $self->_text_style('legend')
644 or return;
645
646 my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
647 for my $count (0 .. $tic_count - 1) {
648 my $x1 = $graph_box->[0] - 5;
649 my $x2 = $graph_box->[0] + 5;
650 my $y1 = $graph_box->[3] - ($count * $tic_distance);
651
652 my $value = sprintf("%.2f", ($count*$interval)+$min);
653 if ($value < 0) {
654 $y1++;
655 }
656 my @box = $self->_text_bbox($value, 'legend')
657 or return;
658
659 $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
660
661 my $width = $box[2];
662 my $height = $box[3];
663
664 $img->string(%text_info,
665 x => ($x1 - $width - 3),
666 y => ($y1 + ($height / 2)),
667 text => $value
668 );
669 }
670
671}
672
673sub _draw_x_tics {
674 my $self = shift;
675
676 my $img = $self->_get_image();
677 my $graph_box = $self->_get_graph_box();
678 my $image_box = $self->_get_image_box();
679
680 my $labels = $self->_get_labels();
681
682 my $tic_count = (scalar @$labels) - 1;
683
684 my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
685
686 # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
687 my $denominator = $tic_count;
688 if ($has_columns) {
689 $denominator ++;
690 }
691 my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
692 my %text_info = $self->_text_style('legend')
693 or return;
694
695 for my $count (0 .. $tic_count) {
696 my $label = $labels->[$count];
697 my $x1 = $graph_box->[0] + ($tic_distance * $count);
698
699 if ($has_columns) {
700 $x1 += $tic_distance / 2;
701 }
702 my $y1 = $graph_box->[3] + 5;
703 my $y2 = $graph_box->[3] - 5;
704
705 $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
706
707 my @box = $self->_text_bbox($label, 'legend')
708 or return;
709
710 my $width = $box[2];
711 my $height = $box[3];
712
713 $img->string(%text_info,
714 x => ($x1 - ($width / 2)),
715 y => ($y1 + ($height + 5)),
716 text => $label
717 );
718
719 }
720}
721
722sub _valid_input {
723 my $self = shift;
724
725 if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
726 return $self->_error("No data supplied");
727 }
728
729 my $data = $self->_get_data_series();
730 if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
731 return $self->_error("No values in data series");
732 }
733 if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
734 return $self->_error("No values in data series");
735 }
736 if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
737 return $self->_error("No values in data series");
738 }
739
740 return 1;
741}
742
743sub _set_column_count { $_[0]->{'column_count'} = $_[1]; }
744sub _set_min_value { $_[0]->{'min_value'} = $_[1]; }
745sub _set_max_value { $_[0]->{'max_value'} = $_[1]; }
746sub _set_image_box { $_[0]->{'image_box'} = $_[1]; }
747sub _set_graph_box { $_[0]->{'graph_box'} = $_[1]; }
748sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
749sub _get_column_count { return $_[0]->{'column_count'} }
750sub _get_min_value { return $_[0]->{'min_value'} }
751sub _get_max_value { return $_[0]->{'max_value'} }
752sub _get_image_box { return $_[0]->{'image_box'} }
753sub _get_graph_box { return $_[0]->{'graph_box'} }
754sub _get_series_counter { return $_[0]->{'series_counter'} }
755
756
757
7581;