File Coverage

blib/lib/Chart/ErrorBars.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


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