File Coverage

blib/lib/Chart/Plot.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#=====================================================================#
# Chart::Plot -- Front end to GD.pm for plotting two dimensional data #
#                by Sanford Morton                 #
#=====================================================================#

# Changes:
#   v 0.0 - 08 March 1998
#           first version
#   v 0.01 - 09 March 1998;
#            - _getOM reports >= max instead of >;
#            - fixed bug in setData() data check
#   v 0.02 - 10 March 1998;
#            - changed error handling in setData() (public method) which
#            now returns undef on success and sets $self->error ;
#            - changed legend to title (public method)
#            - adjusted horizontal tick labels up a bit
#   v 0.03 - 15 March 1998
#            - added colors and dashed line options to dataset graph style
#            - added option to pass dataset as two arrays (@xdata, @ydata)
#            - added hack for case om == max
#   v 0.04 - 15 March 1998
#            - added general purpose setGraphOptions()
#   v 0.05 - 18 March 1998
#            _ added synopsis to pod
#            - added getBounds()
#            - Hor axis label is set below and right centered or justified.
#            - additional vertical offset if title is present; larger font
#   v 0.06 - 22 March 1998
#            - removed title, offset and axis label methods in favor of
#              setGraphOptions()
#            - added getBounds()
#   v 0.07 - 29 May 1998
#            - finally put into standard h2xs form
#            - added check for tick step too small
#            - changed data validity check to permit scientific notation
#              but this invites awful looking tick labels
#   v 0.08 - 15 Dec 1998
#            - added access to GD object: getGDobject() and data2pxl()
#   v 0.09 - 26 July 1999
#            - added custom tick labels: xTickLabels, yTickLabels
#            - added binmode() to install test and demo script
#   v 0.10 - 22 May 2000
#            - added @_image_types and image_type() to use gif, jpeg or png
#              according to local version of GD; modified draw() and _init()
#   v 0.11 - 04 April 2001
#            - fixed bug in draw() to enable jpeg's

package Chart::Plot;

$Chart::Plot::VERSION = '0.11';

use GD;
use strict;


#==================#
#  class variables #
#==================#

# list of image types supported by GD, currently jpeg, png or gif,
# depending on GD version; initialized in _init()
my @_image_types = ();



#==================#
#  public methods  #
#==================#

# usage: $plot = new Chart::Plot(); # default 400 by 300 pixels or
#        $plot = new Chart::Plot(640, 480);
sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->_init (@_);

    return $self;
}

sub setData {
  my $self = shift;
  my ($arrayref1, $arrayref2, $style) = @_;
  my ($arrayref, $i);

  if (ref $arrayref2) { # passing data as two data arrays (x0 ...) (y0 ...)

    unless ($#$arrayref1 = $#$arrayref2) { # error checking
      $self->{'_errorMessage'} = "The dataset does not contain an equal number of x and y values.";
      return 0;
    }

    # check whether data are numeric
    # and construct a single flat array
    for ($i=0; $i<=$#$arrayref1; $i++) {

      if ($$arrayref1[$i] !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
	# if ($$arrayref1[$i] =~ /[^\d\.-]/) {
	$self->{'_errorMessage'} = "The data element $$arrayref1[$i] is non-numeric.";
	return 0;
      }
      if ($$arrayref2[$i] !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
	# if ($$arrayref2[$i] =~ /[^\d\.-]/) {
	$self->{'_errorMessage'} = "The data element $$arrayref2[$i] is non-numeric.";
	return 0;
      }

      # construct a flat array
      $$arrayref[2*$i] = $$arrayref1[$i];
      $$arrayref[2*$i+1] = $$arrayref2[$i];
    }

  } else { # passing data as a single flat data array (x0 y0 ...)

    $arrayref = $arrayref1;
    $style = $arrayref2;

    # check whether array is unbalanced
    if ($#$arrayref % 2 == 0) {
      $self->{'_errorMessage'} = "The dataset does not contain an equal number of x and y values.";
      return 0;
    }

    # check whether data are numeric
    for ($i=0; $i<=$#$arrayref; $i++) {
      if ($$arrayref[$i] !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
	# if ($$arrayref1[$i] =~ /[^\d\.-]/) {
	$self->{'_errorMessage'} = "The data element $$arrayref[$i] is non-numeric.";
	return 0;
      }
    }
  }

  # record the dataset
  my $label = ++$self->{'_numDataSets'};
  $self->{'_data'}->{$label} = $arrayref;
  $self->{'_dataStyle'}->{$label} = ($style ? $style : 'linespoints');

  $self->{'_validMinMax'} = 0; # invalidate any prior min-max calculations
  return $label;
}

sub error {
  my $self = shift;
  return $self->{'_errorMessage'};
}

sub setGraphOptions {
  my $self = shift;
  my %hash = @_;

  for (keys (%hash)) {
    $self->{"_$_"} = $hash{$_};

    # check tick labels for non-numeric positions
    if (/^(x|y)TickLabels$/) {
      my $xory = $1;
      foreach ( keys %{$hash{$_}} ) {
	unless (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
	  $self->{'_errorMessage'} =
	    "The $xory axis tick label position $_ is non-numeric.";
	  return 0;
	}
      }
    }
  }
  return 1;
}

sub getBounds {
  my $self = shift;
  $self->_getMinMax() unless $self->{'_validMinMax'};

  return ($self->{'_xmin'}, $self->{'_ymin'},
	  $self->{'_xmax'}, $self->{'_ymax'});
}

sub image_type {
  return (wantarray ? @_image_types : $_image_types[0]);
}

sub draw {
  my $self = shift;


  # draw stuff in the GD object
  $self->_getMinMax() unless $self->{'_validMinMax'};
  $self->_drawTitle() if $self->{'_title'}; # vert offset may be increased
  $self->_drawAxes();
  $self->_drawData();

  # construct the image and return it.
  # $_image_types[0] is the supported GD format, gif or png or jpeg
  # Damien says no good way around this temp variable
  if ($_[0]) { # image type argument
    unless ( $self->{'_im'}->can($_[0]) ) {
      $self->{'_errorMessage'} = "The image format $_[0] is not supported by this version $GD::VERSION of GD";
      return undef;
    }

    $_ = $_[0];                       # forgot these in ver 0.10
    return $self->{'_im'}->$_();      # an embarrassment

  } else {
    $_ = $_image_types[0];
    return $self->{'_im'}->$_();
  }
}

sub getGDobject {
  my $self = shift;

  if (wantarray) {
    return ( $self->{'_im'},
             $self->{'_black'}, $self->{'_white'},
	     $self->{'_red'}, $self->{'_green'}, $self->{'_blue'},
           );
  } else {
    return $self->{'_im'};
  }
}

sub data2pxl {
  my $self = shift;
  my @data = @_;

  # calculate required translation parameters
  $self->_getMinMax() unless $self->{'_validMinMax'};

  return $self->_data2pxl (@data);
}


#===================#
#  private methods  #
#===================#

# initialization
# this contains a record of all private data except class variables, up top
sub _init {
  my $self = shift;

  #  create an image object
  if ($#_ == 1) {
    $self->{'_im'} = new GD::Image($_[0], $_[1]);
    $self->{'_imx'} = $_[0];
    $self->{'_imy'} = $_[1];
  }
  else {
    $self->{'_im'} = new GD::Image(400,300);
    $self->{'_imx'} = 400;
    $self->{'_imy'} = 300;
  }

  # find format(s) supported by GD
  unless (@_image_types) {
    for ( qw(png gif jpeg) ) {
      push @_image_types, $_ if $self->{'_im'}->can($_);
    }
  }

  # set graph offset; graph will be centered this many pixels within  image
  $self->{'_horGraphOffset'} = 50;
  $self->{'_vertGraphOffset'} = 50;

  # create an empty hash for the datsets
  # data sets and their styles are hashes whose keys are 1 ... _numDataSets
  # and values are refs to flat data arrays or style strings, respectively
  $self->{'_data'} = {};
  $self->{'_dataStyle'} = {};
  $self->{'_numDataSets'} = 0;

  # calculated by _getMinMax and used in translating _data2pxl()
  $self->{'_xmin'} = 0;    $self->{'_xmax'} = 0; # among all datasets
  $self->{'_ymin'} = 0;    $self->{'_ymax'} = 0;
  $self->{'_xslope'} = 0;  $self->{'_yslope'} = 0; # for _data2pxl()
  $self->{'_ax'} = 0;      $self->{'_ay'} = 0;
  $self->{"_omx"} = 0;     $self->{"_omy"} = 0; # for axis ticks
  $self->{'_validMinMax'} = 0; # last calculated min and max still valid

  # initialize text
  ($self->{'_horAxisLabel'}, $self->{'_vertAxisLabel'}) = ('','');
  $self->{'_title'} = '';
  $self->{'_errorMessage'} = '';

  # initialize custom tick labels
  ($self->{'_xTickLabels'}, $self->{'_yTickLabels'}) = (0,0);

  #  allocate some colors
  $self->{'_white'} = $self->{'_im'}->colorAllocate(255,255,255);
  $self->{'_black'} = $self->{'_im'}->colorAllocate(0,0,0);
  $self->{'_red'} = $self->{'_im'}->colorAllocate(255,0,0);
  $self->{'_blue'} = $self->{'_im'}->colorAllocate(0,0,255);
  $self->{'_green'} = $self->{'_im'}->colorAllocate(0,255,0);

  # make the background transparent and interlaced
  $self->{'_im'}->transparent($self->{'_white'});
  $self->{'_im'}->interlaced('true');

  # Put a black frame around the picture
  $self->{'_im'}->rectangle( 0, 0,
			     $self->{'_imx'}-1, $self->{'_imy'}-1,
			     $self->{'_black'});

  # undocumented: in script, use as $plotObject->{'_debugging'} = 1;
  $self->{'_debugging'} = 0;
}


# sets min and max values of all data (_xmin, _ymin, _xmax, _ymax);
# also sets _xslope, _yslope, _ax and _ay used in _data2pxl;
# usage: $self->_getMinMax
sub _getMinMax {
  my $self = shift;
  my ($i, $arrayref);
  my ($xmin, $ymin, $xmax, $ymax);

  # if no data, set arbitrary bounds
  ($xmin, $ymin, $xmax, $ymax) = (0,0,1,1) unless keys %{$self->{'_data'}} > 0;

  # initialize to zero
  $xmin = $xmax = $ymin = $ymax = 0;
  # # or to first data point of an arbitrary dataset
  # foreach (keys %{$self->{'_data'}}) {
  #   $arrayref = $self->{'_data'}->{$_};
  #   $xmin = $xmax = ($self->{'_noZeroX'} ? $$arrayref[0] : 0);
  #   $ymin = $ymax = ($self->{'_noZeroY'} ? $$arrayref[1] : 0);
  #   last; # skip any other datasets
  # }

  # cycle through the datasets looking for min and max values
  foreach (keys %{$self->{'_data'}}) {

    $arrayref = $self->{'_data'}->{$_};

    for ($i=0; $i<$#{$arrayref}; $i++) {
      $xmin = ($xmin > $$arrayref[$i] ? $$arrayref[$i] : $xmin);
      $xmax = ($xmax < $$arrayref[$i] ? $$arrayref[$i] : $xmax);
      $i++;
      $ymin = ($ymin > $$arrayref[$i] ? $$arrayref[$i] : $ymin);
      $ymax = ($ymax < $$arrayref[$i] ? $$arrayref[$i] : $ymax);
    }
  }

  # set axes data ranges as decimal order of magnitude of widest dataset
  ($self->{'_xmin'}, $self->{'_xmax'}) = $self->_getOM ('x', $xmin,$xmax);
  ($self->{'_ymin'}, $self->{'_ymax'}) = $self->_getOM ('y', $ymin,$ymax);

  # calculate conversion constants for _data2pxl()
  $self->{'_xslope'} = ($self->{'_imx'} - 2 * $self->{'_horGraphOffset'})
    / ($self->{'_xmax'} - $self->{'_xmin'});
  $self->{'_yslope'} = ($self->{'_imy'} - 2 * $self->{'_vertGraphOffset'})
    / ($self->{'_ymax'} - $self->{'_ymin'});

  $self->{'_ax'} = $self->{'_horGraphOffset'};
  $self->{'_ay'} = $self->{'_imy'} - $self->{'_vertGraphOffset'};

  $self->{'_validMinMax'} = 1;

  print STDERR
    "_getMinMax(): ($self->{'_omx'}, $self->{'_omy'}) "
      . "($xmin,$xmax) ($ymin,$ymax) "
	. "($self->{'_xmin'}, $self->{'_xmax'}) "
	  . "($self->{'_ymin'}, $self->{'_ymax'})\n"
	    if $self->{'_debugging'};
}


# returns order of magnitude (with decimal) greater than +/- min and max
# sets _omx or _omy used for translating _data2pxl
# usage: ($min, $max) = $self->_getOM ('x', $xmin, $xmax);  # or ('y', $ymin, $ymax)
sub _getOM {
  my $self = shift;
  my $xory = shift;
  my @nums = @_;
  my ($tmp, $om) = (0,0);
  my @sign = ();

  if ($nums[0] == 0 && $nums[1] == 0) {
    $self->{"_om$xory"} = 1;
    return (0,1);
  }
  # find the (exponential) order of magnitude eg, 1000
  foreach (@nums) {
    if ($_<0) {
      push @sign, ('-1');
      $_ = - $_;
    } elsif ($_ == 0) {
      push @sign, ('0');
      next;
    } else {
      push @sign, ('1');
    }

    $tmp = 10 ** (int (log($_) / log(10))); # 1, 10, 100, ... less than $_
    $om = ( $tmp>$om ? $tmp : $om );
  }
  $self->{"_om$xory"} = $om;

  # return the decimal order of magnitude eg, 7000
  # epsilon adjustment in case om equals min or max
  return (0,0) if $om == 0; # to prevent divide by zero
  return ( $om * (int(($_[0]-0.00001*$sign[0])/$om) + $sign[0]),
	   $om * (int(($_[1]-0.00001*$sign[1])/$om) + $sign[1])
	 );
}



# draws all the datasets in $self->{'_data'}
# usage: $self->_drawData()
sub _drawData {
  my $self = shift;
  my ($i, $num, $px, $py, $prevpx, $prevpy, $dataSetLabel, $color);

  foreach $dataSetLabel (keys %{$self->{'_data'}}) {

    # get color
    if ( $self->{'_dataStyle'}->{$dataSetLabel} =~ /((red)|(blue)|(green))/i ) {
      $color = "_$1";
      $color =~ tr/A-Z/a-z/;
    } else {
      $color = '_black';
    }

    # draw the first point
    ($px, $py) = $self->_data2pxl (
			     $self->{'_data'}->{$dataSetLabel} [0],
			     $self->{'_data'}->{$dataSetLabel} [1]
			    );
    $self->{'_im'}->arc($px, $py,4,4,0,360,$self->{$color})
      unless $self->{'_dataStyle'}->{$dataSetLabel} =~ /nopoint/i;

    ($prevpx, $prevpy) = ($px, $py);

    # debugging
    if ($self->{'_debugging'}) {
      $self->{'_im'}->string(gdSmallFont,$px,$py-10,
			     "0($px,$py)",$self->{$color});
      print STDERR "pxldata: 0 ($px, $py)";
    }

    # draw the rest of the points and lines
    $num = @{ $self->{'_data'}->{$dataSetLabel} };
    for ($i=2; $i<$num; $i+=2) {

      # get next point
      ($px, $py) = $self->_data2pxl (
				     $self->{'_data'}->{$dataSetLabel}[$i],
				     $self->{'_data'}->{$dataSetLabel}[$i+1]
				    );

      # draw point, maybe
      $self->{'_im'}->arc($px, $py,4,4,0,360,$self->{$color})
	unless $self->{'_dataStyle'}->{$dataSetLabel} =~ /nopoint/i;

      # draw line from previous point, maybe
      if ($self->{'_dataStyle'}->{$dataSetLabel} =~ /dashed/) {
	$self->{'_im'}->dashedLine($prevpx, $prevpy, $px, $py, $self->{$color});
      } elsif ($self->{'_dataStyle'}->{$dataSetLabel} =~ /noline/i) {
	next;
      } else { # default to solid line
	$self->{'_im'}->line($prevpx, $prevpy, $px, $py, $self->{$color});
      }

      ($prevpx, $prevpy) = ($px, $py);

      # debugging
      if ($self->{'_debugging'}) {
	$self->{'_im'}->string(gdSmallFont,$px-10,$py+10,
			       "$i($px,$py)",$self->{$color});
	print STDERR "$i ($px, $py)";
      }
    }
  }
}



# translate a data point to the nearest pixel point within the graph
# usage: (px,py) = $self->_data2pxl (x,y)
sub _data2pxl {
  my $self = shift;
  my ($x, $y) = @_;

  return ( int ( $self->{'_ax'}
		 + ($x - $self->{'_xmin'}) * $self->{'_xslope'} ),
	   int ( $self->{'_ay'}
		 - ($y - $self->{'_ymin'}) * $self->{'_yslope'} )
	 );
}



# draw the axes, axis labels, ticks and tick labels
# usage: $self->_drawAxes
sub _drawAxes {
  # axes run from data points: x -- ($xmin,0) ($xmax,0);
  #                            y -- (0,$ymin) (0,$ymax);
  # these mins and maxes are decimal orders of magnitude bounding the data

  my $self = shift;
  my ($w,$h) = (gdSmallFont->width, gdSmallFont->height);

  ### horizontal axis
  my ($p1x, $p1y) = $self->_data2pxl ($self->{'_xmin'}, 0);
  my ($p2x, $p2y) = $self->_data2pxl ($self->{'_xmax'}, 0);
  $self->{'_im'}->line($p1x, $p1y, $p2x, $p2y, $self->{'_black'});

  ### axis label
  my $len = $w * length ($self->{'_horAxisLabel'});
  my $xStart = ($p2x+$len/2 > $self->{'_imx'}-10) # center under right end of axis
    ? ($self->{'_imx'}-10-$len) : ($p2x-$len/2);  #   or right justify
  $self->{'_im'}->string (gdSmallFont, $xStart, $p2y+3*$h/2,
			  $self->{'_horAxisLabel'},
			  $self->{'_black'});

  print STDERR "\nHor: p1 ($p1x, $p1y) p2 ($p2x, $p2y)\n"
    if $self->{'_debugging'};

  ### vertical axis
  ($p1x, $p1y) = $self->_data2pxl (0, $self->{'_ymin'});
  ($p2x, $p2y) = $self->_data2pxl (0, $self->{'_ymax'});
  $self->{'_im'}->line($p1x, $p1y, $p2x, $p2y, $self->{'_black'});

  ### axis label
  $xStart = $p2x - length ($self->{'_vertAxisLabel'}) * $w / 2;
  $self->{'_im'}->string (gdSmallFont, ($xStart>10 ? $xStart : 10), $p2y - 2*$h,
			  $self->{'_vertAxisLabel'},
			  $self->{'_black'});

  print STDERR "Ver: p1 ($p1x, $p1y) p2 ($p2x, $p2y)\n"
    if $self->{'_debugging'};

  ###
  ### draw axis ticks and tick labels
  ###
  my ($i,$px,$py, $step);


  ###
  ### horizontal
  ###
  # if horizontal custom tick labels
  if ($self->{'_xTickLabels'}) {

    # a hashref with horizontal data point and label
    # example: %{$self->{'_xTickLabels'} = (10 => 'Ten', 20 => 'Twenty', ...)
    foreach ( keys %{$self->{'_xTickLabels'}} ) {

      ($px,$py) = $self->_data2pxl($_, 0);
      $self->{'_im'}->line($px, $py-2, $px, $py+2, $self->{'_black'});
      $self->{'_im'}->string ( gdSmallFont,
			       $px-length( ${$self-> {'_xTickLabels'}}{$_} ) * $w/2,
                               $py+$h/2,
                               ${$self->{'_xTickLabels'}}{$_},
                               $self->{'_black'}
     );
    }

  } else {

    # horizontal step calculation
    $step = $self->{'_omx'};
    # step too large
    $step /= 2  if ($self->{'_xmax'} - $self->{'_xmin'}) / $step < 6;
    # once again. A poor hack for case  om = max.
    $step /= 2  if ($self->{'_xmax'} - $self->{'_xmin'}) / $step < 6;
    # step too small. As long as we are doing poor hacks
    $step *= 2  if ($self->{'_xmax'} - $self->{'_xmin'}) / $step > 12;

    for ($i=$self->{'_xmin'}; $i <= $self->{'_xmax'}; $i+=$step ) {
      ($px,$py) = $self->_data2pxl($i, 0);
      $self->{'_im'}->line($px, $py-2, $px, $py+2, $self->{'_black'});
      $self->{'_im'}->string (gdSmallFont,
			      $px-length($i)*$w/2, $py+$h/2,
			      $i, $self->{'_black'}) unless $i == 0;
    }
    print STDERR "Horstep: $step ($self->{'_xmax'} - $self->{'_xmin'})/$self->{'_omx'})\n"
      if $self->{'_debugging'};
  }

  ###
  ### vertical
  ###
  if ($self->{'_yTickLabels'}) {
    foreach ( keys %{$self->{'_yTickLabels'}} ) {
      ($px,$py) = $self->_data2pxl(0, $_);
      $self->{'_im'}->line($px-2, $py, $px+2, $py, $self->{'_black'});
      $self->{'_im'}->string ( gdSmallFont,
			       $px-(1+length( ${$self->{'_yTickLabels'}}{$_} )) * $h/2,
                               $py-$h/2,
                               ${$self->{'_yTickLabels'}}{$_},
                               $self->{'_black'});
    }
  } else {
    $step = $self->{'_omy'};
    $step /= 2  if ($self->{'_ymax'} - $self->{'_ymin'}) / $step < 6;
    $step /= 2  if ($self->{'_ymax'} - $self->{'_ymin'}) / $step < 6;
    $step *= 2  if ($self->{'_ymax'} - $self->{'_ymin'}) / $step > 12;

    for ($i=$self->{'_ymin'}; $i <= $self->{'_ymax'}; $i+=$step ) {
      ($px,$py) = $self->_data2pxl (0, $i);
      $self->{'_im'}->line($px-2, $py, $px+2, $py, $self->{'_black'});
      $self->{'_im'}->string (gdSmallFont,
			      $px-5-length($i)*$w, $py-$h/2,
			      $i, $self->{'_black'}) unless $i == 0;
    }
    print STDERR "Verstep: $step ($self->{'_ymax'} - $self->{'_ymin'})/$self->{'_omy'})\n"
      if $self->{'_debugging'};
  }
}


sub _drawTitle {
  my $self = shift;
  my ($w,$h) = (gdMediumBoldFont->width, gdMediumBoldFont->height);

  # increase vert offset and recalculate conversion constants for _data2pxl()
  $self->{'_vertGraphOffset'} += 2*$h;

  $self->{'_xslope'} = ($self->{'_imx'} - 2 * $self->{'_horGraphOffset'})
    / ($self->{'_xmax'} - $self->{'_xmin'});
  $self->{'_yslope'} = ($self->{'_imy'} - 2 * $self->{'_vertGraphOffset'})
    / ($self->{'_ymax'} - $self->{'_ymin'});

  $self->{'_ax'} = $self->{'_horGraphOffset'};
  $self->{'_ay'} = $self->{'_imy'} - $self->{'_vertGraphOffset'};


  # centered below chart
  my ($px,$py) = ($self->{'_imx'}/2, # $self->{'_vertGraphOffset'}/2);
		  $self->{'_imy'} - $self->{'_vertGraphOffset'}/2);

  ($px,$py) = ($px - length ($self->{'_title'}) * $w/2, $py+$h/2);
  $self->{'_im'}->string (gdMediumBoldFont, $px, $py,
			  $self->{'_title'},
			  $self->{'_black'});
}

1;

__END__