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