File Coverage

blib/lib/Chart/Pareto.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::Pareto
3             #
4             # written and maintained by
5             # @author Chart Group at Geodetic Fundamental Station Wettzell (Chart@fs.wettzell.de)
6             # @date 2012-10-03
7             # @version 2.4.6
8             #
9              
10             ## @class Chart::Pareto
11             # @brief Pareto class derived class for Chart to implement
12             #
13             package Chart::Pareto;
14              
15 3     3   5506 use Chart::Base '2.4.6';
  0            
  0            
16             use GD;
17             use Carp;
18             use strict;
19              
20             @Chart::Pareto::ISA = qw(Chart::Base);
21             $Chart::Pareto::VERSION = '2.4.6';
22              
23             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
24             # public methods go here #
25             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
26              
27             #>>>>>>>>>>>>>>>>>>>>>>>>>>>#
28             # private methods go here #
29             #<<<<<<<<<<<<<<<<<<<<<<<<<<<#
30              
31             ## @fn private _find_y_scale
32             #calculate the range with the sum dataset1. all datas has to be positiv
33             sub _find_y_range
34             {
35             my $self = shift;
36             my $data = $self->{'dataref'};
37             my $sum = 0;
38              
39             for ( my $i = 0 ; $i < $self->{'num_datapoints'} ; $i++ )
40             {
41             if ( $data->[1][$i] >= 0 )
42             {
43             $sum += $data->[1][$i];
44             }
45             else
46             {
47             carp "We need positiv data, if we want to draw a pareto graph!!";
48             return 0;
49             }
50             }
51              
52             #store the sum
53             $self->{'sum'} = $sum;
54              
55             #return the range
56             ( 0, $sum );
57             }
58              
59             ## @fn private _sort_data
60             # sort the data
61             sub _sort_data
62             {
63             my $self = shift;
64             my $data = $self->{'dataref'};
65             my @labels = @{ $data->[0] };
66             my @values = @{ $data->[1] };
67              
68             # sort the values and their labels
69             @labels = @labels[ sort { $values[$b] <=> $values[$a] } 0 .. $#labels ];
70             @values = sort { $b <=> $a } @values;
71              
72             #save the sorted values and their labels
73             @{ $data->[0] } = @labels;
74             @{ $data->[1] } = @values;
75              
76             #finally return
77             return 1;
78             }
79              
80             ## @fn private _draw_legend
81             # let them know what all the pretty colors mean
82             sub _draw_legend
83             {
84             my $self = shift;
85             my ($length);
86             my $num_dataset;
87              
88             # check to see if legend type is none..
89             if ( $self->{'legend'} =~ /^none$/ )
90             {
91             return 1;
92             }
93              
94             # check to see if they have as many labels as datasets,
95             # warn them if not
96             if ( ( $#{ $self->{'legend_labels'} } >= 0 )
97             && ( ( scalar( @{ $self->{'legend_labels'} } ) ) != 2 ) )
98             {
99             carp "I need two legend labels. One for the data and one for the sum.";
100             }
101              
102             # init a field to store the length of the longest legend label
103             unless ( $self->{'max_legend_label'} )
104             {
105             $self->{'max_legend_label'} = 0;
106             }
107              
108             # fill in the legend labels, find the longest one
109             unless ( $self->{'legend_labels'}[0] )
110             {
111             $self->{'legend_labels'}[0] = "Dataset";
112             }
113             unless ( $self->{'legend_labels'}[1] )
114             {
115             $self->{'legend_labels'}[1] = "Running sum";
116             }
117              
118             if ( length( $self->{'legend_labels'}[0] ) > length( $self->{'legend_labels'}[1] ) )
119             {
120             $self->{'max_legend_label'} = length( $self->{'legend_labels'}[0] );
121             }
122             else
123             {
124             $self->{'max_legend_label'} = length( $self->{'legend_labels'}[1] );
125             }
126              
127             #set the number of datasets to 2, and store it
128             $num_dataset = $self->{'num_datasets'};
129             $self->{'num_datasets'} = 2;
130              
131             # different legend types
132             if ( $self->{'legend'} eq 'bottom' )
133             {
134             $self->_draw_bottom_legend;
135             }
136             elsif ( $self->{'legend'} eq 'right' )
137             {
138             $self->_draw_right_legend;
139             }
140             elsif ( $self->{'legend'} eq 'left' )
141             {
142             $self->_draw_left_legend;
143             }
144             elsif ( $self->{'legend'} eq 'top' )
145             {
146             $self->_draw_top_legend;
147             }
148             else
149             {
150             carp "I can't put a legend there (at " . $self->{'legend'} . ")\n";
151             }
152              
153             #reload the number of datasets
154             $self->{'num_datasets'} = $num_dataset;
155              
156             # and return
157             return 1;
158             }
159              
160             ## @fn private _draw_data
161             # finally get around to plotting the data
162             sub _draw_data
163             {
164             my $self = shift;
165             my $data = $self->{'dataref'};
166             my $misccolor = $self->_color_role_to_index('misc');
167             my ( $x1, $x2, $x3, $y1, $y2, $y3, $y1_line, $y2_line, $x1_line, $x2_line, $h, $w );
168             my ( $width, $height, $delta1, $delta2, $map, $mod, $cut );
169             my ( $i, $j, $color, $line_color, $percent, $per_label, $per_label_len );
170             my $sum = $self->{'sum'};
171             my $curr_sum = 0;
172             my $font = $self->{'legend_font'};
173             my $pink = $self->{'gd_obj'}->colorAllocate( 255, 0, 255 );
174             my $diff;
175              
176             # make sure we're using a real font
177             unless ( ( ref($font) ) eq 'GD::Font' )
178             {
179             croak "The subtitle font you specified isn\'t a GD Font object";
180             }
181              
182             # get the size of the font
183             ( $h, $w ) = ( $font->height, $font->width );
184              
185             # init the imagemap data field if they wanted it
186             if ( $self->true( $self->{'imagemap'} ) )
187             {
188             $self->{'imagemap_data'} = [];
189             }
190              
191             # find both delta values ($delta1 for stepping between different
192             # datapoint names, $delta2 for setpping between datasets for that
193             # point) and the mapping constant
194             $width = $self->{'curr_x_max'} - $self->{'curr_x_min'};
195             $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
196             $delta1 = $width / ( $self->{'num_datapoints'} > 0 ? $self->{'num_datapoints'} : 1 );
197             $diff = ( $self->{'max_val'} - $self->{'min_val'} );
198             $diff = 1 if $diff == 0;
199             $map = $height / $diff;
200             if ( $self->true( $self->{'spaced_bars'} ) )
201             {
202             $delta2 = $delta1 / 3;
203             }
204             else
205             {
206             $delta2 = $delta1;
207             }
208              
209             # get the base x-y values
210             $x1 = $self->{'curr_x_min'};
211             $y1 = $self->{'curr_y_max'};
212             $y1_line = $y1;
213             $mod = $self->{'min_val'};
214             $x1_line = $self->{'curr_x_min'};
215              
216             # draw the bars and the lines
217             $color = $self->_color_role_to_index('dataset0');
218             $line_color = $self->_color_role_to_index('dataset1');
219              
220             # draw every bar for this dataset
221             for $j ( 0 .. $self->{'num_datapoints'} )
222             {
223              
224             # don't try to draw anything if there's no data
225             if ( defined( $data->[1][$j] ) )
226             {
227              
228             #calculate the percent value for this data and the actual sum;
229             $curr_sum += $data->[1][$j];
230             $percent = int( $curr_sum / ( $sum || 1 ) * 100 );
231              
232             # find the bounds of the rectangle
233             if ( $self->true( $self->{'spaced_bars'} ) )
234             {
235             $x2 = $x1 + ( $j * $delta1 ) + $delta2;
236             }
237             else
238             {
239             $x2 = $x1 + ( $j * $delta1 );
240             }
241             $y2 = $y1;
242             $x3 = $x2 + $delta2;
243             $y3 = $y1 - ( ( $data->[1][$j] - $mod ) * $map );
244              
245             #cut the bars off, if needed
246             if ( $data->[1][$j] > $self->{'max_val'} )
247             {
248             $y3 = $y1 - ( ( $self->{'max_val'} - $mod ) * $map );
249             $cut = 1;
250             }
251             elsif ( $data->[1][$j] < $self->{'min_val'} )
252             {
253             $y3 = $y1 - ( ( $self->{'min_val'} - $mod ) * $map );
254             $cut = 1;
255             }
256             else
257             {
258             $cut = 0;
259             }
260              
261             # draw the bar
262             ## y2 and y3 are reversed in some cases because GD's fill
263             ## algorithm is lame
264             $self->{'gd_obj'}->filledRectangle( $x2, $y3, $x3, $y2, $color );
265             if ( $self->true( $self->{'imagemap'} ) )
266             {
267             $self->{'imagemap_data'}->[1][$j] = [ $x2, $y3, $x3, $y2 ];
268             }
269              
270             # now outline it. outline red if the bar had been cut off
271             unless ($cut)
272             {
273             $self->{'gd_obj'}->rectangle( $x2, $y3, $x3, $y2, $misccolor );
274             }
275             else
276             {
277              
278             $self->{'gd_obj'}->rectangle( $x2, $y3, $x3, $y2, $pink );
279             }
280             $x2_line = $x3;
281             if ( $self->{'max_val'} >= $curr_sum )
282             {
283              
284             #get the y value
285             $y2_line = $y1 - ( ( $curr_sum - $mod ) * $map );
286              
287             #draw the line
288             $self->{'gd_obj'}->line( $x1_line, $y1_line, $x2_line, $y2_line, $line_color );
289              
290             #draw a little rectangle at the end of the line
291             $self->{'gd_obj'}->filledRectangle( $x2_line - 2, $y2_line - 2, $x2_line + 2, $y2_line + 2, $line_color );
292              
293             #draw the label for the percent value
294             $per_label = $percent . '%';
295             $per_label_len = length($per_label) * $w;
296             $self->{'gd_obj'}->string( $font, $x2_line - $per_label_len - 1, $y2_line - $h - 1, $per_label, $line_color );
297              
298             #update the values for next the line
299             $y1_line = $y2_line;
300             $x1_line = $x2_line;
301             }
302             else
303             {
304              
305             #get the y value
306             $y2_line = $y1 - ( ( $self->{'max_val'} - $mod ) * $map );
307              
308             #draw the line
309             $self->{'gd_obj'}->line( $x1_line, $y1_line, $x2_line, $y2_line, $pink );
310              
311             #draw a little rectangle at the end of the line
312             $self->{'gd_obj'}->filledRectangle( $x2_line - 2, $y2_line - 2, $x2_line + 2, $y2_line + 2, $pink );
313              
314             #draw the label for the percent value
315             $per_label = $percent . '%';
316             $per_label_len = length($per_label) * $w;
317             $self->{'gd_obj'}->string( $font, $x2_line - $per_label_len - 1, $y2_line - $h - 1, $per_label, $pink );
318              
319             #update the values for the next line
320             $y1_line = $y2_line;
321             $x1_line = $x2_line;
322             }
323              
324             }
325             else
326             {
327             if ( $self->true( $self->{'imagemap'} ) )
328             {
329             $self->{'imagemap_data'}->[1][$j] = [ undef(), undef(), undef(), undef() ];
330             }
331             }
332             }
333              
334             # and finaly box it off
335             $self->{'gd_obj'}
336             ->rectangle( $self->{'curr_x_min'}, $self->{'curr_y_min'}, $self->{'curr_x_max'}, $self->{'curr_y_max'}, $misccolor );
337             return;
338              
339             }
340              
341             ## be a good module and return 1
342             1;