Edit file File name : Pareto.pm Content :## @file # Implementation of Chart::Pareto # # written and maintained by # @author Chart Group at Geodetic Fundamental Station Wettzell (Chart@fs.wettzell.de) # @date 2015-03-01 # @version 2.4.10 # ## @class Chart::Pareto # @brief Pareto class derived class for Chart to implement # package Chart::Pareto; use Chart::Base '2.4.10'; use GD; use Carp; use strict; @Chart::Pareto::ISA = qw(Chart::Base); $Chart::Pareto::VERSION = '2.4.10'; #>>>>>>>>>>>>>>>>>>>>>>>>>># # public methods go here # #<<<<<<<<<<<<<<<<<<<<<<<<<<# #>>>>>>>>>>>>>>>>>>>>>>>>>>># # private methods go here # #<<<<<<<<<<<<<<<<<<<<<<<<<<<# ## @fn private _find_y_scale #calculate the range with the sum dataset1. all datas has to be positiv sub _find_y_range { my $self = shift; my $data = $self->{'dataref'}; my $sum = 0; for ( my $i = 0 ; $i < $self->{'num_datapoints'} ; $i++ ) { if ( $data->[1][$i] >= 0 ) { $sum += $data->[1][$i]; } else { carp "We need positiv data, if we want to draw a pareto graph!!"; return 0; } } #store the sum $self->{'sum'} = $sum; #return the range ( 0, $sum ); } ## @fn private _sort_data # sort the data sub _sort_data { my $self = shift; my $data = $self->{'dataref'}; my @labels = @{ $data->[0] }; my @values = @{ $data->[1] }; # sort the values and their labels @labels = @labels[ sort { $values[$b] <=> $values[$a] } 0 .. $#labels ]; @values = sort { $b <=> $a } @values; #save the sorted values and their labels @{ $data->[0] } = @labels; @{ $data->[1] } = @values; #finally return return 1; } ## @fn private _draw_legend # let them know what all the pretty colors mean sub _draw_legend { my $self = shift; my ($length); my $num_dataset; # check to see if legend type is none.. if ( $self->{'legend'} =~ /^none$/ ) { return 1; } # check to see if they have as many labels as datasets, # warn them if not if ( ( $#{ $self->{'legend_labels'} } >= 0 ) && ( ( scalar( @{ $self->{'legend_labels'} } ) ) != 2 ) ) { carp "I need two legend labels. One for the data and one for the sum."; } # init a field to store the length of the longest legend label unless ( $self->{'max_legend_label'} ) { $self->{'max_legend_label'} = 0; } # fill in the legend labels, find the longest one unless ( $self->{'legend_labels'}[0] ) { $self->{'legend_labels'}[0] = "Dataset"; } unless ( $self->{'legend_labels'}[1] ) { $self->{'legend_labels'}[1] = "Running sum"; } if ( length( $self->{'legend_labels'}[0] ) > length( $self->{'legend_labels'}[1] ) ) { $self->{'max_legend_label'} = length( $self->{'legend_labels'}[0] ); } else { $self->{'max_legend_label'} = length( $self->{'legend_labels'}[1] ); } #set the number of datasets to 2, and store it $num_dataset = $self->{'num_datasets'}; $self->{'num_datasets'} = 2; # different legend types if ( $self->{'legend'} eq 'bottom' ) { $self->_draw_bottom_legend; } elsif ( $self->{'legend'} eq 'right' ) { $self->_draw_right_legend; } elsif ( $self->{'legend'} eq 'left' ) { $self->_draw_left_legend; } elsif ( $self->{'legend'} eq 'top' ) { $self->_draw_top_legend; } else { carp "I can't put a legend there (at " . $self->{'legend'} . ")\n"; } #reload the number of datasets $self->{'num_datasets'} = $num_dataset; # and return return 1; } ## @fn private _draw_data # finally get around to plotting the data sub _draw_data { my $self = shift; my $data = $self->{'dataref'}; my $misccolor = $self->_color_role_to_index('misc'); my ( $x1, $x2, $x3, $y1, $y2, $y3, $y1_line, $y2_line, $x1_line, $x2_line, $h, $w ); my ( $width, $height, $delta1, $delta2, $map, $mod, $cut ); my ( $i, $j, $color, $line_color, $percent, $per_label, $per_label_len ); my $sum = $self->{'sum'}; my $curr_sum = 0; my $font = $self->{'legend_font'}; my $pink = $self->{'gd_obj'}->colorAllocate( 255, 0, 255 ); my $diff; # make sure we're using a real font unless ( ( ref($font) ) eq 'GD::Font' ) { croak "The subtitle font you specified isn\'t a GD Font object"; } # get the size of the font ( $h, $w ) = ( $font->height, $font->width ); # init the imagemap data field if they wanted it if ( $self->true( $self->{'imagemap'} ) ) { $self->{'imagemap_data'} = []; } # find both delta values ($delta1 for stepping between different # datapoint names, $delta2 for setpping between datasets for that # point) and the mapping constant $width = $self->{'curr_x_max'} - $self->{'curr_x_min'}; $height = $self->{'curr_y_max'} - $self->{'curr_y_min'}; $delta1 = $width / ( $self->{'num_datapoints'} > 0 ? $self->{'num_datapoints'} : 1 ); $diff = ( $self->{'max_val'} - $self->{'min_val'} ); $diff = 1 if $diff == 0; $map = $height / $diff; if ( $self->true( $self->{'spaced_bars'} ) ) { $delta2 = $delta1 / 3; } else { $delta2 = $delta1; } # get the base x-y values $x1 = $self->{'curr_x_min'}; $y1 = $self->{'curr_y_max'}; $y1_line = $y1; $mod = $self->{'min_val'}; $x1_line = $self->{'curr_x_min'}; # draw the bars and the lines $color = $self->_color_role_to_index('dataset0'); $line_color = $self->_color_role_to_index('dataset1'); # draw every bar for this dataset for $j ( 0 .. $self->{'num_datapoints'} ) { # don't try to draw anything if there's no data if ( defined( $data->[1][$j] ) ) { #calculate the percent value for this data and the actual sum; $curr_sum += $data->[1][$j]; $percent = int( $curr_sum / ( $sum || 1 ) * 100 ); # find the bounds of the rectangle if ( $self->true( $self->{'spaced_bars'} ) ) { $x2 = $x1 + ( $j * $delta1 ) + $delta2; } else { $x2 = $x1 + ( $j * $delta1 ); } $y2 = $y1; $x3 = $x2 + $delta2; $y3 = $y1 - ( ( $data->[1][$j] - $mod ) * $map ); #cut the bars off, if needed if ( $data->[1][$j] > $self->{'max_val'} ) { $y3 = $y1 - ( ( $self->{'max_val'} - $mod ) * $map ); $cut = 1; } elsif ( $data->[1][$j] < $self->{'min_val'} ) { $y3 = $y1 - ( ( $self->{'min_val'} - $mod ) * $map ); $cut = 1; } else { $cut = 0; } # draw the bar ## y2 and y3 are reversed in some cases because GD's fill ## algorithm is lame $self->{'gd_obj'}->filledRectangle( $x2, $y3, $x3, $y2, $color ); if ( $self->true( $self->{'imagemap'} ) ) { $self->{'imagemap_data'}->[1][$j] = [ $x2, $y3, $x3, $y2 ]; } # now outline it. outline red if the bar had been cut off unless ($cut) { $self->{'gd_obj'}->rectangle( $x2, $y3, $x3, $y2, $misccolor ); } else { $self->{'gd_obj'}->rectangle( $x2, $y3, $x3, $y2, $pink ); } $x2_line = $x3; if ( $self->{'max_val'} >= $curr_sum ) { #get the y value $y2_line = $y1 - ( ( $curr_sum - $mod ) * $map ); #draw the line $self->{'gd_obj'}->line( $x1_line, $y1_line, $x2_line, $y2_line, $line_color ); #draw a little rectangle at the end of the line $self->{'gd_obj'}->filledRectangle( $x2_line - 2, $y2_line - 2, $x2_line + 2, $y2_line + 2, $line_color ); #draw the label for the percent value $per_label = $percent . '%'; $per_label_len = length($per_label) * $w; $self->{'gd_obj'}->string( $font, $x2_line - $per_label_len - 1, $y2_line - $h - 1, $per_label, $line_color ); #update the values for next the line $y1_line = $y2_line; $x1_line = $x2_line; } else { #get the y value $y2_line = $y1 - ( ( $self->{'max_val'} - $mod ) * $map ); #draw the line $self->{'gd_obj'}->line( $x1_line, $y1_line, $x2_line, $y2_line, $pink ); #draw a little rectangle at the end of the line $self->{'gd_obj'}->filledRectangle( $x2_line - 2, $y2_line - 2, $x2_line + 2, $y2_line + 2, $pink ); #draw the label for the percent value $per_label = $percent . '%'; $per_label_len = length($per_label) * $w; $self->{'gd_obj'}->string( $font, $x2_line - $per_label_len - 1, $y2_line - $h - 1, $per_label, $pink ); #update the values for the next line $y1_line = $y2_line; $x1_line = $x2_line; } } else { if ( $self->true( $self->{'imagemap'} ) ) { $self->{'imagemap_data'}->[1][$j] = [ undef(), undef(), undef(), undef() ]; } } } # and finaly box it off $self->{'gd_obj'} ->rectangle( $self->{'curr_x_min'}, $self->{'curr_y_min'}, $self->{'curr_x_max'}, $self->{'curr_y_max'}, $misccolor ); return; } ## be a good module and return 1 1; Save