File Coverage

blib/lib/Chart/Pareto.pm
Criterion Covered Total %
statement 99 141 70.2
branch 18 48 37.5
condition 0 3 0.0
subroutine 8 8 100.0
pod n/a
total 125 200 62.5


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