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 2015-03-01 7# @version 2.4.10 8# 9 10## @class Chart::Pareto 11# @brief Pareto class derived class for Chart to implement 12# 13package Chart::Pareto; 14 15use Chart::Base '2.4.10'; 16use GD; 17use Carp; 18use strict; 19 20@Chart::Pareto::ISA = qw(Chart::Base); 21$Chart::Pareto::VERSION = '2.4.10'; 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 33sub _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 61sub _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 82sub _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 162sub _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 3421; 343