Chart/StackedBars.pm - metacpan.org

## @file
# Implementation of Chart::StackedBars
#
# written by
# @author david bonner (dbonner@cs.bu.edu)
#
# maintained by the
# @author Chart Group at Geodetic Fundamental Station Wettzell (Chart@fs.wettzell.de)
# @date 2012-10-03
# @version 2.4.6
#

## @class Chart::StackedBars
# StackedBars class derived from class Base.
#
# This class provides all functions which are specific to
# stacked bars
package Chart::StackedBars;

use Chart::Base '2.4.6';
use GD;
use Carp;
use strict;

@Chart::StackedBars::ISA     = qw(Chart::Base);
$Chart::StackedBars::VERSION = '2.4.6';

#>>>>>>>>>>>>>>>>>>>>>>>>>>#
#  public methods go here  #
#<<<<<<<<<<<<<<<<<<<<<<<<<<#

#>>>>>>>>>>>>>>>>>>>>>>>>>>>#
#  private methods go here  #
#<<<<<<<<<<<<<<<<<<<<<<<<<<<#

## @fn private _check_data
# override check_data to make sure we don't get datasets with positive
# and negative values mixed
sub _check_data
{
    my $self   = shift;
    my $data   = $self->{'dataref'};
    my $length = 0;
    my ( $i, $j, $posneg );
    my $composite;

    # remember the number of datasets
    if ( defined $self->{'composite_info'} )
    {
        if ( $self->{'composite_info'}[0][0] =~ /^StackedBars$/i )
        {
            $composite = 0;
        }
        if ( $self->{'composite_info'}[1][0] =~ /^StackedBars$/i )
        {
            $composite = 1;
        }

        # $self->{'num_datasets'} = $#{$data};     ###

        $self->{'num_datasets'} = ( $#{ $self->{'composite_info'}[$composite][1] } ) + 1;
    }
    else
    {
        $self->{'num_datasets'} = $#{$data};
    }

    # remember the number of points in the largest dataset
    $self->{'num_datapoints'} = 0;
    for ( 0 .. $self->{'num_datasets'} )
    {
        if ( scalar( @{ $data->[$_] } ) > $self->{'num_datapoints'} )
        {
            $self->{'num_datapoints'} = scalar( @{ $data->[$_] } );
        }
    }

    # make sure the datasets don't mix pos and neg values
    for $i ( 0 .. $self->{'num_datapoints'} - 1 )
    {
        $posneg = '';
        for $j ( 1 .. $self->{'num_datasets'} )
        {
            if ( $data->[$j][$i] > 0 )
            {
                if ( $posneg eq 'neg' )
                {
                    croak "The values for a Chart::StackedBars data point must either be all positive or all negative";
                }
                else
                {
                    $posneg = 'pos';
                }
            }
            elsif ( $data->[$j][$i] < 0 )
            {
                if ( $posneg eq 'pos' )
                {
                    croak "The values for a Chart::StackedBars data point must either be all positive or all negative";
                }
                else
                {
                    $posneg = 'neg';
                }
            }
        }
    }

    # find good min and max y-values for the plot
    $self->_find_y_scale;

    # find the longest x-tick label
    for ( @{ $data->[0] } )
    {
        if ( length($_) > $length )
        {
            $length = length($_);
        }
    }

    # now store it in the object
    $self->{'x_tick_label_length'} = $length;

    return;
}

## @fn private _find_y_range
sub _find_y_range
{
    my $self = shift;

    #   This finds the minimum and maximum point-sum over all x points,
    #   where the point-sum is the sum of the dataset values for that point.
    #   If the y value in any dataset is undef for a given x, it simply
    #   adds nothing to the sum.

    my $data = $self->{'dataref'};
    my $max  = undef;
    my $min  = undef;
    for my $i ( 0 .. $#{ $data->[0] } )
    {    # data point
        my $sum = $data->[1]->[$i] || 0;
        for my $dataset ( @$data[ 2 .. $#$data ] )
        {    # order not important
            my $datum = $dataset->[$i];
            $sum += $datum if defined $datum;
        }
        if ( defined $max )
        {
            if    ( $sum > $max ) { $max = $sum }
            elsif ( $sum < $min ) { $min = $sum }
        }
        else { $min = $max = $sum }
    }

    # make sure all-positive or all-negative charts get anchored at
    # zero so that we don't cut out some parts of the bars
    if ( ( $max > 0 ) && ( $min > 0 ) )
    {
        $min = 0;
    }
    if ( ( $min < 0 ) && ( $max < 0 ) )
    {
        $max = 0;
    }

    ( $min, $max );
}

# ## override _find_y_scale to account for stacked bars
# sub _find_y_scale {
#   my $self = shift;
#   my $raw = $self->{'dataref'};
#   my $data = [@{$raw->[1]}];
#   my ($i, $j, $max, $min);
#   my ($order, $mult, $tmp);
#   my ($range, $delta, @dec, $y_ticks);
#   my $labels = [];
#   my $length = 0;
#
#   # use realy weird max and min values
#   $max = -999999999999;
#   $min = 999999999999;
#
#   # go through and stack them
#   for $i (0..$self->{'num_datapoints'}-1) {
#     for $j (2..$self->{'num_datasets'}) {
#       $data->[$i] += $raw->[$j][$i];
#     }
#   }
#
#   # get max and min values
#   for $i (0..$self->{'num_datapoints'}-1) {
#     if ($data->[$i] > $max) {
#       $max = $data->[$i];
#     }
#     if ($data->[$i] < $min) {
#       $min = $data->[$i];
#     }
#   }
#
#   # make sure all-positive or all-negative charts get anchored at
#   # zero so that we don't cut out some parts of the bars
#   if (($max > 0) && ($min > 0)) {
#     $min = 0;
#   }
#   if (($min < 0) && ($max < 0)) {
#     $max = 0;
#   }
#
#   # calculate good max value
#   if ($max < -10) {
#     $tmp = -$max;
#     $order = int((log $tmp) / (log 10));
#     $mult = int ($tmp / (10 ** $order));
#     $tmp = ($mult - 1) * (10 ** $order);
#     $max = -$tmp;
#   }
#   elsif ($max < 0) {
#     $max = 0;
#   }
#   elsif ($max > 10) {
#     $order = int((log $max) / (log 10));
#     $mult = int ($max / (10 ** $order));
#     $max = ($mult + 1) * (10 ** $order);
#   }
#   elsif ($max >= 0) {
#     $max = 10;
#   }
#
#   # now go for a good min
#   if ($min < -10) {
#     $tmp = -$min;
#     $order = int((log $tmp) / (log 10));
#     $mult = int ($tmp / (10 ** $order));
#     $tmp = ($mult + 1) * (10 ** $order);
#     $min = -$tmp;
#   }
#   elsif ($min < 0) {
#     $min = -10;
#   }
#   elsif ($min > 10) {
#     $order = int ((log $min) / (log 10));
#     $mult = int ($min / (10 ** $order));
#     $min = $mult * (10 ** $order);
#   }
#   elsif ($min >= 0) {
#     $min = 0;
#   }
#
#   # put the appropriate min and max values into the object if necessary
#   unless (defined ($self->{'max_val'})) {
#     $self->{'max_val'} = $max;
#   }
#   unless (defined ($self->{'min_val'})) {
#     $self->{'min_val'} = $min;
#   }
#
#   # generate the y_tick labels, store them in the object
#   # figure out which one is going to be the longest
#   $range = $self->{'max_val'} - $self->{'min_val'};
#   $y_ticks = $self->{'y_ticks'} - 1;
#   ## Don't adjust y_ticks if the user specified custom labels
#   if ($self->{'integer_ticks_only'} =~ /^true$/i && ! $self->{'y_tick_labels'}) {
#     unless (($range % $y_ticks) == 0) {
#       while (($range % $y_ticks) != 0) {
# 	$y_ticks++;
#       }
#       $self->{'y_ticks'} = $y_ticks + 1;
#     }
#   }
#
#   $delta = $range / $y_ticks;
#   for (0..$y_ticks) {
#     $tmp = $self->{'min_val'} + ($delta * $_);
#     @dec = split /\./, $tmp;
#     if ($dec[1] && (length($dec[1]) > 3)) {
#       $tmp = sprintf("%.3f", $tmp);
#     }
#     $labels->[$_] = $tmp;
#     if (length($tmp) > $length) {
#       $length = length($tmp);
#     }
#   }
#
#   # store it in the object
#   $self->{'y_tick_labels'} = $labels;
#   $self->{'y_tick_label_length'} = $length;
#
#   # and return
#   return;
# }

## @fn private _draw_data
# finally get around to plotting the data
sub _draw_data
{
    my $self      = shift;
    my $raw       = $self->{'dataref'};
    my $data      = [];
    my $misccolor = $self->_color_role_to_index('misc');
    my ( $width, $height, $delta, $map, $mod );
    my ( $x1, $y1, $x2, $y2, $x3, $y3, $i, $j, $color, $cut );
    my $pink = $self->{'gd_obj'}->colorAllocate( 255, 0, 255 );

    # init the imagemap data field if they want it
    if ( $self->true( $self->{'imagemap'} ) )
    {
        $self->{'imagemap_data'} = [];
    }

    # width and height of remaining area, delta for width of bars, mapping value
    $width = $self->{'curr_x_max'} - $self->{'curr_x_min'};

    if ( $self->true( $self->{'spaced_bars'} ) )
    {
        $delta = ( $width / ( $self->{'num_datapoints'} * 2 ) );
    }
    else
    {
        $delta = $width / $self->{'num_datapoints'};
    }
    $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
    $map = $height / ( $self->{'max_val'} - $self->{'min_val'} );

    # get the base x and y values
    $x1 = $self->{'curr_x_min'};
    if ( $self->{'min_val'} >= 0 )
    {
        $y1  = $self->{'curr_y_max'};
        $mod = $self->{'min_val'};
    }
    elsif ( $self->{'max_val'} <= 0 )
    {
        $y1  = $self->{'curr_y_min'};
        $mod = $self->{'max_val'};
    }
    else
    {
        $y1 = $self->{'curr_y_min'} + ( $map * $self->{'max_val'} );
        $mod = 0;
        $self->{'gd_obj'}->line( $self->{'curr_x_min'}, $y1, $self->{'curr_x_max'}, $y1, $misccolor );
    }

    # create another copy of the data, but stacked
    $data->[1] = [ @{ $raw->[1] } ];
    for $i ( 0 .. $self->{'num_datapoints'} - 1 )
    {
        for $j ( 2 .. $self->{'num_datasets'} )
        {
            $data->[$j][$i] = $data->[ $j - 1 ][$i] + $raw->[$j][$i];
        }
    }

    # draw the damn bars
    for $i ( 0 .. $self->{'num_datapoints'} - 1 )
    {

        # init the y values for this datapoint
        $y2 = $y1;

        for $j ( 1 .. $self->{'num_datasets'} )
        {

            # get the color
            $color = $self->_color_role_to_index( 'dataset' . ( $j - 1 ) );

            # set up the geometry for the bar
            if ( $self->true( $self->{'spaced_bars'} ) )
            {
                $x2 = $x1 + ( 2 * $i * $delta ) + ( $delta / 2 );
                $x3 = $x2 + $delta;

            }
            else
            {
                $x2 = $x1 + ( $i * $delta );
                $x3 = $x2 + $delta;
            }
            $y3 = $y1 - ( ( $data->[$j][$i] - $mod ) * $map );

            #cut the bars off, if needed
            if ( $data->[$j][$i] > $self->{'max_val'} )
            {
                $y3 = $y1 - ( ( $self->{'max_val'} - $mod ) * $map );
                $cut = 1;
            }
            elsif ( $data->[$j][$i] < $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
            if ( $data->[$j][$i] > 0 )
            {
                $self->{'gd_obj'}->filledRectangle( $x2, $y3, $x3, $y2, $color );
                if ( $self->true( $self->{'imagemap'} ) )
                {
                    $self->{'imagemap_data'}->[$j][$i] = [ $x2, $y3, $x3, $y2 ];
                }
            }
            else
            {
                $self->{'gd_obj'}->filledRectangle( $x2, $y2, $x3, $y3, $color );
                if ( $self->true( $self->{'imagemap'} ) )
                {
                    $self->{'imagemap_data'}->[$j][$i] = [ $x2, $y2, $x3, $y3 ];
                }
            }

            # now outline it. outline red if the bar had been cut off
            unless ($cut)
            {
                $self->{'gd_obj'}->rectangle( $x2, $y2, $x3, $y3, $misccolor );
            }
            else
            {
                $self->{'gd_obj'}->rectangle( $x2, $y2, $x3, $y3, $misccolor );
                $self->{'gd_obj'}->rectangle( $x2, $y1, $x3, $y3, $pink );
            }

            # now bootstrap the y values
            $y2 = $y3;
        }
    }

    # 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;

}

## @fn private _draw_left_legend
sub _draw_left_legend
{
    my $self   = shift;
    my @labels = @{ $self->{'legend_labels'} };
    my ( $x1, $x2, $x3, $y1, $y2, $width, $color, $misccolor, $w, $h, $brush );
    my $font = $self->{'legend_font'};

    # 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 );

    # get the miscellaneous color
    $misccolor = $self->_color_role_to_index('misc');

    # find out how wide the largest label is
    $width =
      ( 2 * $self->{'text_space'} ) +
      ( $self->{'max_legend_label'} * $w ) +
      $self->{'legend_example_size'} +
      ( 2 * $self->{'legend_space'} );

    # get some base x-y coordinates
    $x1 = $self->{'curr_x_min'};
    $x2 = $self->{'curr_x_min'} + $width;
    $y1 = $self->{'curr_y_min'} + $self->{'graph_border'};
    $y2 =
      $self->{'curr_y_min'} +
      $self->{'graph_border'} +
      $self->{'text_space'} +
      ( $self->{'num_datasets'} * ( $h + $self->{'text_space'} ) ) +
      ( 2 * $self->{'legend_space'} );

    # box the legend off
    $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $misccolor );

    # leave that nice space inside the legend box
    $x1 += $self->{'legend_space'};
    $y1 += $self->{'legend_space'} + $self->{'text_space'};

    # now draw the actual legend
    for ( 0 .. $#labels )
    {

        # get the color
        my $c = $self->{'num_datasets'} - $_ - 1;

        # color of the datasets in the legend
        if ( $self->{'dataref'}[1][0] < 0 )
        {
            $color = $self->_color_role_to_index( 'dataset' . $_ );
        }
        else
        {
            $color = $self->_color_role_to_index( 'dataset' . $c );
        }

        # find the x-y coords
        $x2 = $x1;
        $x3 = $x2 + $self->{'legend_example_size'};
        $y2 = $y1 + ( $_ * ( $self->{'text_space'} + $h ) ) + $h / 2;

        # do the line first
        $self->{'gd_obj'}->line( $x2, $y2, $x3, $y2, $color );

        # reset the brush for points
        $brush = $self->_prepare_brush( $color, 'point', $self->{ 'pointStyle' . $_ } );
        $self->{'gd_obj'}->setBrush($brush);

        # draw the point
        $self->{'gd_obj'}->line( int( ( $x3 + $x2 ) / 2 ), $y2, int( ( $x3 + $x2 ) / 2 ), $y2, gdBrushed );

        # now the label
        $x2 = $x3 + ( 2 * $self->{'text_space'} );
        $y2 -= $h / 2;

        # order of the datasets in the legend
        if ( $self->{'dataref'}[1][0] < 0 )
        {
            $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$_], $color );
        }
        else
        {
            $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$c], $color );
        }
    }

    # mark off the used space
    $self->{'curr_x_min'} += $width;

    # and return
    return 1;
}

## @fn private _draw_right_legend
sub _draw_right_legend
{
    my $self   = shift;
    my @labels = @{ $self->{'legend_labels'} };
    my ( $x1, $x2, $x3, $y1, $y2, $width, $color, $misccolor, $w, $h, $brush );
    my $font = $self->{'legend_font'};

    # 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 );

    # get the miscellaneous color
    $misccolor = $self->_color_role_to_index('misc');

    # find out how wide the largest label is
    $width =
      ( 2 * $self->{'text_space'} ) +
      ( $self->{'max_legend_label'} * $w ) +
      $self->{'legend_example_size'} +
      ( 2 * $self->{'legend_space'} );

    # get some starting x-y values
    $x1 = $self->{'curr_x_max'} - $width;
    $x2 = $self->{'curr_x_max'};
    $y1 = $self->{'curr_y_min'} + $self->{'graph_border'};
    $y2 =
      $self->{'curr_y_min'} +
      $self->{'graph_border'} +
      $self->{'text_space'} +
      ( $self->{'num_datasets'} * ( $h + $self->{'text_space'} ) ) +
      ( 2 * $self->{'legend_space'} );

    # box the legend off
    $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $misccolor );

    # leave that nice space inside the legend box
    $x1 += $self->{'legend_space'};
    $y1 += $self->{'legend_space'} + $self->{'text_space'};

    # now draw the actual legend
    for ( 0 .. $#labels )
    {

        # get the color
        my $c = $self->{'num_datasets'} - $_ - 1;

        # color of the datasets in the legend

        if ( $self->{'dataref'}[1][0] < 0 )
        {
            $color = $self->_color_role_to_index( 'dataset' . $_ );
        }
        else
        {
            $color = $self->_color_role_to_index( 'dataset' . $c );
        }

        # find the x-y coords
        $x2 = $x1;
        $x3 = $x2 + $self->{'legend_example_size'};
        $y2 = $y1 + ( $_ * ( $self->{'text_space'} + $h ) ) + $h / 2;

        # do the line first
        $self->{'gd_obj'}->line( $x2, $y2, $x3, $y2, $color );

        # reset the brush for points
        $brush = $self->_prepare_brush( $color, 'point', $self->{ 'pointStyle' . $_ } );
        $self->{'gd_obj'}->setBrush($brush);

        # draw the point
        $self->{'gd_obj'}->line( int( ( $x3 + $x2 ) / 2 ), $y2, int( ( $x3 + $x2 ) / 2 ), $y2, gdBrushed );

        # now the label
        $x2 = $x3 + ( 2 * $self->{'text_space'} );
        $y2 -= $h / 2;

        # order of the datasets in the legend
        if ( $self->{'dataref'}[1][0] < 0 )
        {
            $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$_], $color );
        }
        else
        {
            $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$c], $color );
        }
    }

    # mark off the used space
    $self->{'curr_x_max'} -= $width;

    # and return
    return 1;
}

## be a good module and return 1
1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)