File Coverage

blib/lib/Chart/ErrorBars.pm
Criterion Covered Total %
statement 142 185 76.8
branch 60 98 61.2
condition 12 24 50.0
subroutine 8 8 100.0
pod n/a
total 222 315 70.5


line stmt bran cond sub pod time code
1             #====================================================================
2             # Chart::ErrorBars
3             #
4             # written by Chart-Group
5             #
6             # maintained by the Chart Group
7             # Chart@wettzell.ifag.de
8             #
9             #---------------------------------------------------------------------
10             # History:
11             #----------
12             # $RCSfile: ErrorBars.pm,v $ $Revision: 1.2 $ $Date: 2003/02/14 13:32:48 $
13             # $Author: dassing $
14             # $Log: ErrorBars.pm,v $
15             # Revision 1.2 2003/02/14 13:32:48 dassing
16             # First setup
17             #
18             #====================================================================
19              
20             package Chart::ErrorBars;
21              
22 2     2   62 use Chart::Base 2.3;
  2         52  
  2         36  
23 2     2   40 use GD;
  2         19  
  2         36  
24 2     2   31 use Carp;
  2         19  
  2         30  
25 2     2   30 use strict;
  2         18  
  2         27  
26              
27             @Chart::ErrorBars::ISA = qw(Chart::Base);
28             $Chart::ErrorBars::VERSION = '2.3';
29              
30             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
31             # public methods go here #
32             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
33              
34              
35              
36             #>>>>>>>>>>>>>>>>>>>>>>>>>>>#
37             # private methods go here #
38             #<<<<<<<<<<<<<<<<<<<<<<<<<<<#
39              
40             ## finally get around to plotting the data
41             sub _draw_data {
42 2     2   101   my $self = shift;
43 2         21   my $data = $self->{'dataref'};
44 2         28   my $misccolor = $self->_color_role_to_index('misc');
45 2         20   my ($x1, $x2, $x3, $y1, $y2, $y3, $mod, $y_error_up, $y_error_down);
46 2         19   my ($width, $height, $delta, $map, $delta_num, $zero_offset, $flag);
47 2         19   my ($i, $j, $color, $brush);
48 2         19   my $dataset =0;
49 2         18   my $diff;
50               
51             # init the imagemap data field if they want it
52 2 50       27   if ($self->{'imagemap'} =~ /^true$/i) {
53 0         0     $self->{'imagemap_data'} = [];
54               }
55              
56             # find the delta value between data points, as well
57             # as the mapping constant
58 2         22   $width = $self->{'curr_x_max'} - $self->{'curr_x_min'};
59 2         315   $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
60 2 50       30   $delta = $width / ( $self->{'num_datapoints'} > 0 ? $self->{'num_datapoints'} : 1);
61 2         20   $diff = $self->{'max_val'} - $self->{'min_val'};
62 2 50       26   $diff = 1 if $diff == 0;
63 2         20   $map = $height / $diff;
64              
65             #for a xy-plot, use this delta and maybe an offset for the zero-axes
66 2 50       27   if ($self->{'xy_plot'} =~ /^true$/i ) {
67 2         57     $diff = $self->{'x_max_val'} - $self->{'x_min_val'};
68 2 50       24     $diff = 1 if $diff == 0;
69 2         18     $delta_num = $width / $diff;
70              
71 2 100 66     37     if ($self->{'x_min_val'} <= 0 && $self->{'x_max_val'} >= 0) {
    50 33        
72 1         11        $zero_offset = abs($self->{'x_min_val'}) * abs($delta_num);
73                 }
74                 elsif ($self->{'x_min_val'} > 0 || $self->{'x_max_val'} < 0) {
75 1         12        $zero_offset = -$self->{'x_min_val'} * $delta_num;
76                 }
77                 else {
78 0         0        $zero_offset = 0;
79                 }
80               }
81               
82             # get the base x-y values
83 2 50       23   if ($self->{'xy_plot'} =~ /^false$/i ) {
84 0         0     $x1 = $self->{'curr_x_min'} + ($delta / 2);
85               }
86               else {
87 2         20     $x1 = $self->{'curr_x_min'};
88               }
89 2 50       24   if ($self->{'min_val'} >= 0) {
    0          
90 2         20     $y1 = $self->{'curr_y_max'};
91 2         21     $mod = $self->{'min_val'};
92               }
93               elsif ($self->{'max_val'} <= 0) {
94 0         0     $y1 = $self->{'curr_y_min'};
95 0         0     $mod = $self->{'max_val'};
96               }
97               else {
98 0         0     $y1 = $self->{'curr_y_min'} + ($map * $self->{'max_val'});
99 0         0     $mod = 0;
100 0         0     $self->{'gd_obj'}->line ($self->{'curr_x_min'}, $y1,
101                                          $self->{'curr_x_max'}, $y1,
102                                          $misccolor);
103               }
104              
105             # first of all box it off
106 2         142   $self->{'gd_obj'}->rectangle ($self->{'curr_x_min'},
107                $self->{'curr_y_min'},
108             $self->{'curr_x_max'},
109             $self->{'curr_y_max'},
110             $misccolor);
111               
112             # draw the points
113 2         23   for $i (1..$self->{'num_datasets'}) {
114 5 100       58     if ($self->{'same_error'} =~ /^false$/i) {
115             # get the color for this dataset, and set the brush
116 3         48      $color = $self->_color_role_to_index('dataset'.($dataset)); # draw every point for this dataset
117 3 100       33      $dataset++ if (($i-1)%3 == 0);
118 3         31      for $j (0..$self->{'num_datapoints'}) {
119             #get the brush for points
120 51         519       $brush = $self->_prepare_brush ($color, 'point');
121 51         995       $self->{'gd_obj'}->setBrush ($brush);
122                   
123             # only draw if the current set is really a dataset and no errorset
124 51 100       500       if ( ($i-1)%3 == 0) {
125             # don't try to draw anything if there's no data
126 17 100       254        if (defined ($data->[$i][$j]) ) {
127 16 50       202           if ($self->{'xy_plot'} =~ /^true$/i ) {
128 16         196            $x2 = $x1 + $delta_num * $data->[0][$j] + $zero_offset+1;
129 16         134            $x3 = $x2 ;
130                       }
131                       else {
132 0         0            $x2 = $x1 + ($delta * $j)+1;
133 0         0            $x3 = $x2;
134                       }
135 16         185 $y2 = $y1 - (($data->[$i][$j] - $mod) * $map);
136 16         131 $y3 = $y2;
137 16         433           $y_error_up = $y2-abs($data->[$i+1][$j]) *$map;
138 16         165           $y_error_down= $y2+abs($data->[$i+2][$j]) *$map;
139              
140             # draw the point only if it is within the chart borders
141 16 50 33     1971           if ($data->[$i][$j] <= $self->{'max_val'} && $data->[$i][$j] >= $self->{'min_val'}) {
142 16         213             $self->{'gd_obj'}->line($x2, $y2, $x3, $y3, gdBrushed);
143 16         147             $flag = 'true';
144                       }
145              
146             #reset the brush for lines
147 16         159           $brush = $self->_prepare_brush ($color, 'line');
148 16         286           $self->{'gd_obj'}->setBrush ($brush);
149                     
150             #draw the error bars
151 16 50       174           if ($flag =~ /^true$/i) {
152              
153             # the upper lines
154 16         221             $self->{'gd_obj'}->line($x2, $y2, $x3, $y_error_up, gdBrushed);
155 16         180             $self->{'gd_obj'}->line($x2-3, $y_error_up, $x3+3, $y_error_up, gdBrushed);
156              
157             # the down lines
158 16         165             $self->{'gd_obj'}->line($x2, $y2, $x3, $y_error_down, gdBrushed);
159 16         171             $self->{'gd_obj'}->line($x2-3, $y_error_down, $x3+3, $y_error_down, gdBrushed);
160 16         143             $flag = 'false';
161                       }
162             # store the imagemap data if they asked for it
163 16 50       176 if ($self->{'imagemap'} =~ /^true$/i) {
164 0         0 $self->{'imagemap_data'}->[$i][$j] = [ $x2, $y2 ];
165             }
166                     }
167                   }
168                  }
169                 }
170                 else {
171             # get the color for this dataset, and set the brush
172 2         43      $color = $self->_color_role_to_index('dataset'.($dataset)); # draw every point for this dataset
173 2 100       24      $dataset++ if (($i-1)%2 == 0);
174 2         20      for $j (0..$self->{'num_datapoints'}) {
175             #get the brush for points
176 34         355       $brush = $self->_prepare_brush ($color, 'point');
177 34         557       $self->{'gd_obj'}->setBrush ($brush);
178              
179             # only draw if the current set is really a dataset and no errorset
180 34 100       345       if ( ($i-1)%2 == 0) {
181             # don't try to draw anything if there's no data
182 17 100       175        if (defined ($data->[$i][$j]) ) {
183 16 50       165           if ($self->{'xy_plot'} =~ /^true$/i ) {
184 16         159            $x2 = $x1 + $delta_num * $data->[0][$j] + $zero_offset;
185 16         134            $x3 = $x2 ;
186                       }
187                       else {
188 0         0            $x2 = $x1 + ($delta * $j);
189 0         0            $x3 = $x2;
190                       }
191 16         186 $y2 = $y1 - (($data->[$i][$j] - $mod) * $map);
192 16         158 $y3 = $y2;
193 16         156           $y_error_up = $y2-abs($data->[$i+1][$j]) *$map;
194 16         148           $y_error_down= $y2+abs($data->[$i+1][$j]) *$map;
195              
196             # draw the point only if it is within the chart borders
197 16 100 66     227           if ($data->[$i][$j] <= $self->{'max_val'} && $data->[$i][$j] >= $self->{'min_val'}) {
198 15         162             $self->{'gd_obj'}->line($x2, $y2, $x3, $y3, gdBrushed);
199 15         133             $flag = 'true';
200                       }
201              
202             #reset the brush for lines
203 16         152           $brush = $self->_prepare_brush ($color, 'line');
204 16         278           $self->{'gd_obj'}->setBrush ($brush);
205              
206             #draw the error bars
207 16 100       230           if ($flag =~ /^true$/i) {
208              
209             # the upper lines
210 15         155             $self->{'gd_obj'}->line($x2, $y2, $x3, $y_error_up, gdBrushed);
211 15         166             $self->{'gd_obj'}->line($x2-3, $y_error_up, $x3+3, $y_error_up, gdBrushed);
212              
213             # the down lines
214 15         245             $self->{'gd_obj'}->line($x2, $y2, $x3, $y_error_down, gdBrushed);
215 15         200             $self->{'gd_obj'}->line($x2-3, $y_error_down, $x3+3, $y_error_down, gdBrushed);
216 15         134             $flag = 'false';
217                       }
218             # store the imagemap data if they asked for it
219 16 50       187 if ($self->{'imagemap'} =~ /^true$/i) {
220 0         0 $self->{'imagemap_data'}->[$i][$j] = [ $x2, $y2 ];
221             }
222                    }
223                   }
224                  }
225                 }
226               }
227              
228 2         42   return 1;
229             }
230              
231              
232             ## set the gdBrush object to trick GD into drawing fat lines
233             sub _prepare_brush {
234 117     117   980   my $self = shift;
235 117         955   my $color = shift;
236 117         1036   my $type = shift;
237 117         1078   my ($radius, @rgb, $brush, $white, $newcolor);
238              
239             # get the rgb values for the desired color
240 117         1919   @rgb = $self->{'gd_obj'}->rgb($color);
241              
242             # get the appropriate brush size
243 117 100       1294   if ($type eq 'line') {
    50          
244 32         330     $radius = $self->{'brush_size'}/2;
245               }
246               elsif ($type eq 'point') {
247 85         2556     $radius = $self->{'pt_size'}/2;
248               }
249              
250             # create the new image
251 117         1524   $brush = GD::Image->new ($radius*2, $radius*2);
252              
253             # get the colors, make the background transparent
254 117         4354   $white = $brush->colorAllocate (255,255,255);
255 117         1237   $newcolor = $brush->colorAllocate (@rgb);
256 117         1457   $brush->transparent ($white);
257              
258             # draw the circle
259 117         5408   $brush->arc ($radius-1, $radius-1, $radius, $radius, 0, 360, $newcolor);
260              
261             # fill it if we're using lines
262 117         1488   $brush->fill ($radius-1, $radius-1, $newcolor);
263              
264             # set the new image as the main object's brush
265 117         2381   return $brush;
266             }
267              
268              
269             ## let them know what all the pretty colors mean
270             sub _draw_legend {
271 2     2   20   my $self = shift;
272 2         19   my ($length, $step, $temp, $post_length);
273 2         19   my $j = 0;
274              
275             # check to see if legend type is none..
276 2 50       39   if ($self->{'legend'} =~ /^none$/) {
277 2         25     return 1;
278               }
279               
280             #just for later checking and warning
281 0 0       0   if ($#{$self->{'legend_labels'}} >= 0) {
  0         0  
282 0         0     $post_length = scalar(@{$self->{'legend_labels'}});
  0         0  
283               }
284              
285             #look if every second or eyery third dataset is a set for data
286 0 0       0   if ( $self->{'same_error'} =~ /^false$/i) {
287 0         0      $step = 3;
288               }
289               else {
290 0         0      $step = 2;
291               }
292              
293             # init a field to store the length of the longest legend label
294 0 0       0   unless ($self->{'max_legend_label'}) {
295 0         0     $self->{'max_legend_label'} = 0;
296               }
297             # fill in the legend labels, find the longest one
298               for (my $i = 1; $i < $self->{'num_datasets'}; $i += $step) {
299 0         0      my $label = $j+1;
300 0 0       0     unless ($self->{'legend_labels'}[$j]) {
301 0         0       $self->{'legend_labels'}[$j] = "Dataset $label";
302                 }
303 0         0     $length = length($self->{'legend_labels'}[$j]);
304 0 0       0     if ($length > $self->{'max_legend_label'}) {
305 0         0       $self->{'max_legend_label'} = $length;
306                 }
307 0         0     $j++;
308 0         0   }
309               
310             #we just have to label the datasets in the legend
311             #we'll reset it, to draw the sets
312 0         0   $temp = $self->{'num_datasets'};
313 0         0   $self->{'num_datasets'} = $j;
314              
315             # check to see if they have as many labels as datasets,
316             # warn them if not
317 0 0 0     0   if ( ($post_length > 0) && ($post_length != $j) ) {
318 0         0     carp "The number of legend labels and datasets doesn\'t match";
319               }
320               
321             # different legend types
322 0 0       0   if ($self->{'legend'} eq 'bottom') {
    0          
    0          
    0          
323 0         0     $self->_draw_bottom_legend;
324               }
325               elsif ($self->{'legend'} eq 'right') {
326 0         0     $self->_draw_right_legend;
327               }
328               elsif ($self->{'legend'} eq 'left') {
329 0         0     $self->_draw_left_legend;
330               }
331               elsif ($self->{'legend'} eq 'top') {
332 0         0     $self->_draw_top_legend;
333               } else {
334 0         0     carp "I can't put a legend there (at ".$self->{'legend'}.")\n";
335               }
336              
337             #reset the number of dataset to make sure that everything goes right
338 0         0   $self->{'num_datasets'} = $temp;
339              
340             # and return
341 0         0   return 1;
342             }
343              
344             #find the range of the x scale, don't forget the errors!
345             sub _find_y_range {
346 2     2   20   my $self = shift;
347 2         21   my $data = $self->{'dataref'};
348              
349 2         19   my $max = undef;
350 2         18   my $min = undef;
351 2 100       31   if ($self->{'same_error'} =~ /^false$/i) {
352 1         13     for my $i (1..$self->{'num_datasets'}) {
353 3 100       36       if ( ($i-1)%3 == 0) {
354 1         10         for my $j (0..$self->{'num_datapoints'}) {
355 17 100 66     309           if (defined ($data->[$i][$j]) && defined($data->[$i+1][$j]) && defined($data->[$i+2][$j]) ){
      66        
356 16 100       139              if (defined $max){
  1         11  
357 15 100       183                if ( ($data->[$i][$j] + abs($data->[$i+1][$j])) > $max ) {
358 7         97                  $max = $data->[$i][$j] + abs($data->[$i+1][$j]);
359                            }
360 15 100       187                if ( ($data->[$i][$j] - abs($data->[$i+2][$j])) < $min ) {
361 3         31                  $min = $data->[$i][$j] - abs($data->[$i+2][$j]);
362                            }
363                          }
364                          else {$min = $max = $data->[$i][$j];}
365                       }
366                     }
367                   }
368 1         17     }return ($min, $max);
369               }
370               else {
371 1         11     for my $i (1..$self->{'num_datasets'}) {
372 2 100       28       if ( ($i-1)%2 == 0) {
373 1         36         for my $j (0..$self->{'num_datapoints'}) {
374 17 100 66     220           if (defined ($data->[$i][$j]) && defined($data->[$i+1][$j]) ){
375 16 100       280              if (defined $max){
  1         61  
376 15 100       189                if ( ($data->[$i][$j] + $data->[$i+1][$j]) > $max ) {
377 7         64                  $max = $data->[$i][$j] + $data->[$i+1][$j];
378                            }
379 15 100       187                if ( ($data->[$i][$j] - $data->[$i+1][$j]) < $min ) {
380 2         21                  $min = $data->[$i][$j] - $data->[$i+1][$j];
381                            }
382                          }
383                          else {$min = $max = $data->[$i][$j];}
384                       }
385                     }
386                   }
387                 }
388 1         23     return ($min, $max);
389               }
390             }
391             ## be a good module and return 1
392             1;
393