GD::Chart::Radial - plot and output Radial or Radar charts using the GD library.


GD-Chart-Radial documentation Contained in the GD-Chart-Radial distribution.

Index


Code Index:

NAME

Top

GD::Chart::Radial - plot and output Radial or Radar charts using the GD library.

SYNOPSIS

Top

  use GD::Chart::Radial;

  my $chart = GD::Chart::Radial->new($width, $height);
  $chart->set(title=>"This is a chart");
  $chart->plot(\@data);
  print OUTFILE $chart->png;

DESCRIPTION

Top

This module allows you to plot and output Radial or Radar charts using the GD library. The module is based on GD::Graph in how it can be used where possible.

A radial chart has multiple axis spread out from the centre, like spokes on a wheel. Each axis represents a particular measurement. Values are plotted by marking the value for what is being measured on each axis and optionally joining these points. The result can look like a spiderweb or a radar depending on how you plot the values.

METHODS

Top

new

This constructor method creates a new chart object.

  my $chart = GD::Chart::Radial->new($width,$height);

set

This accessor sets attributes of the graph such as the Title

  $chart->set(title=>"This is a chart");

or

  $chart->set(
        legend            => [qw/april may/],
        title             => 'Some simple graph',
        y_max_value       => $max,
        y_tick_number     => 5,
        style             => 'Notch',
        colours           => [qw/white black red blue green/],
       );

Style can be Notch, Circle, Polygon or Fill. The default style is Notch. Where style is set to Fill, the data sets are also filled, as opposed to lines drawn for all other styles

Colours can be any of the following: white, black, red, blue, purple, green, grey, light_grey, dark_grey, cream, yellow, orange. The first colour is used for the background colour, the second is used for the scale markings, while the remaining colours represent the different data sets. If there are less colours than data sets, colours will be taken from the unused set of defined colours.

The default list of colours are white, black, red, blue and green, i.e. white background, black scale markings and data sets in red blue and green.

Both legend and title can be undefined. If this is the case then the relavent entry will not appear on the graph. This is useful if you plan to use other forms of labelling along with the graph, and only require the image.

plot

This method plots the chart based on the data provided and the attributes of the graph.

  my @data = ([qw/A B C D E F G/],
              [12,21,23,30,23,22,5],
              [10,20,21,24,28,15,9]);
  $chart->plot(\@data);

png

returns a PNG image for output to a file or wherever.

  open(IMG, '>test.png') or die $!;
  binmode IMG;
  print IMG $chart->png;
  close IMG

jpg

returns a JPEG image for output to a file or elsewhere, see png.

gif

returns a GIF image for output to a file or elsewhere, see png.

gd

returns a GD image for output to a file or elsewhere, see png.

Internal Methods

In order to draw the points on the chart, the following 6 shape drawing functions are used:

draw_shape
draw_diamond
draw_square
draw_circle
draw_triangle
draw_cross

TODO

Top

* Allow long labels to run on multiple lines.

SEE ALSO

Top

GD, GD::Graph, Imager::Chart::Radial

AUTHOR

Top

  Original Author: Aaron J Trevena <aaron@droogs.org>
  Current Maintainer: Barbie <barbie@missbarbell.co.uk>

COPYRIGHT & LICENSE

Top


GD-Chart-Radial documentation Contained in the GD-Chart-Radial distribution.
#####################################################################
# Radial - A module to generate radial charts as JPG and PNG images #
# (c) Copyright 2002,2004-2007 Aaron J  Trevena                     #
# (c) Copyright 2007 Barbie                                         #
#####################################################################
package GD::Chart::Radial;

use strict;
use warnings;
use Data::Dumper;
use GD;

our $VERSION = 0.07;

my %COLOURS = (
    white      => [255,255,255],
    black      => [0,0,0],
    red        => [255,0,0],
    blue       => [0,0,255],
    purple     => [230,0,230],
    green      => [0,255,0],
    grey       => [128,128,128],
    light_grey => [170,170,170],
    dark_grey  => [75,75,75],
    cream      => [200,200,240],
    yellow     => [255,255,0],
    orange     => [255,128,0],
);

my %FONT = (
    1 => [5, gdSmallFont, gdTinyFont, gdTinyFont],
    2 => [10, gdMediumBoldFont, gdSmallFont, gdTinyFont],
    3 => [15, gdLargeFont, gdMediumBoldFont, gdSmallFont],
    4 => [20, gdGiantFont, gdLargeFont, gdMediumBoldFont],
    5 => [20, gdGiantFont, gdGiantFont, gdLargeFont],
    6 => [20, gdGiantFont, gdGiantFont, gdGiantFont],
);

my @FONT = sort keys %FONT;

sub new {
  my ($class, $width, $height, $debug) = (@_,0);

  # instantiate Chart
  my $chart = {};
  bless($chart, ref($class) || $class);

  # initialise Chart
  $chart->{width}  = $width;
  $chart->{height} = $height;
  $chart->{debug}  = $debug;
  $chart->{PI}     = 4 * atan2 1, 1;
  return $chart;
}

sub set {
  my $self = shift;
  my %attributes = @_;
  foreach my $attribute (%attributes) {
    next unless ($attributes{$attribute});
    $self->{$attribute} = $attributes{$attribute};
  }
}

sub plot {
  my $self = shift;
  return    unless(@_);

  my @values = @{shift()};
  my @labels = @{shift(@values)};
  my @records;

  if($self->{colours}) {
      for(@{$self->{colours}}) {
          next  unless(/^\#[a-f0-9]{3}([a-f0-9]{3})?$/i);
          my ($r,$g,$b);
          if(length($_) == 7) {
            my ($r,$g,$b) = (/^\#(..)(..)(..)$/);
            $COLOURS{$_} = [hex($r),hex($g),hex($b)];
          } else {
            my ($r,$g,$b) = (/^\#(.)(.)(.)$/);
            $COLOURS{$_} = [hex("$r$r"),hex("$g$g"),hex("$b$b")];
          }
      }

      # ensure we only have valid colours
      my @c = grep {$COLOURS{$_}} @{$self->{colours}};
      $self->{colours} = \@c;
  }

  my $BGColour  = $self->{colours} ? shift @{$self->{colours}} : 'white';
  my $FGColour  = $self->{colours} ? shift @{$self->{colours}} : 'black';
  my @DSColours = $self->{colours} ? @{$self->{colours}} : qw/red blue green yellow orange/;

  # try and avoid running out of colours
  my %AllColours = map {$_ => 1} keys %COLOURS;
  delete $AllColours{$_}   for($BGColour,$FGColour,@DSColours);
  push @DSColours, keys %AllColours;
  while(scalar(@labels) > scalar(@DSColours) || scalar(@values) > scalar(@DSColours)) {
    push @DSColours, @DSColours;
  }

#print STDERR "\n#Colours:";
#print STDERR "\n#Background=$BGColour";
#print STDERR "\n#Markings  =$FGColour";
#print STDERR "\n#Labels    =".(join(",",@DSColours));
#print STDERR "\n#Legends   =".(join(",",@{$self->{legend}}));
#print STDERR "\n";

#print STDERR "\n#Data:";
#print STDERR "\n#Labels=".(join(",",@labels));
#print STDERR "\n#Points=[".(join("][", map{join(",",@$_)} @values))."]";
#print STDERR "\n";

  my $Max = 0;
  my $r = 0;
  foreach my $values (@values) {
    my $record = { Colour => $DSColours[$r] };
    $record->{Label} = $self->{legend}->[$r]    if($self->{legend});
    my $v = 0;
    foreach my $value (@$values) {
      $record->{Values}->{$labels[$v]} = $value;
      $Max = $value if($Max < $value);
      $v++;
    }
    push(@records,$record);
    $r++;
  }

  $self->{records} = \@records;
  $self->{y_max_value}   ||= $Max;
  $self->{y_tick_number} ||= $Max;

  my $PI = $self->{PI};

  # style can be Fill, Circle, Polygon or Notch
  my %scale = (
           Max       => $self->{y_max_value},
           Divisions => $self->{y_tick_number},
           Style     => $self->{style} || "Notch",
           Colour    => $FGColour
          );

  # calculate image dimensions
  my (@axis, %axis_lookup);
  my $longest_axis_label = 0;
  my $a = 0;
  foreach my $key (@labels) {
    push (@axis, { Label => "$key" });
    $axis_lookup{$key} = $a;
    $longest_axis_label = length $key
      if (length $key > $longest_axis_label);
    $a++;
  }

  my $number_of_axis = scalar @axis;
  my $legend_height = 0;

  if($self->{legend}) {
      $legend_height = 8 + (15 * scalar @{$self->{records}});
  }

  my $left_space    = 15 + $longest_axis_label * 6;
  my $right_space   = 15 + $longest_axis_label * 6;
  my $top_space     = $self->{title} ? 50 : 15;
  my $bottom_space  = $self->{legend} ? 30 + $legend_height : 15;

  unless($self->{width})  { $self->{width}  = 200 + $left_space + $right_space; }
  unless($self->{height}) { $self->{height} = 200 + $top_space + $bottom_space; }

  my $x_radius = int(($self->{width}  - $left_space - $right_space) / 2);
  my $y_radius = int(($self->{height} - $top_space - $bottom_space) / 2);
  my $min_radius = 100;

  $x_radius = $min_radius   if($x_radius < $min_radius);
  $y_radius = $min_radius   if($y_radius < $min_radius);
  $x_radius = $y_radius     if($x_radius > $y_radius);
  $y_radius = $x_radius     if($y_radius > $x_radius);

  $top_space += _font_offset($x_radius);

  my $x_centre  = $left_space + $x_radius;
  my $y_centre  = $top_space + $y_radius;
  my $height    = (2 * $y_radius) + $bottom_space + $top_space;
  my $width     = (2 * $x_radius) + $left_space + $right_space;

#print STDERR "\n#width=$width, height=$height\n"  if($self->{debug});
  $self->{_im} = GD::Image->new($width,$height);

  # define the colours and fonts
  my %colours = map {$_ => $self->{_im}->colorAllocate(@{$COLOURS{$_}})} ($BGColour,$FGColour,@DSColours);
  $self->{fonts}   = {
      Title  => _font_size(1,$x_radius),
      Label  => _font_size(2,$x_radius),
      Legend => _font_size(3,$x_radius)
  };

  my (@Axis,@Label,@Notch);
  my $Theta = 90;
  my $i = $number_of_axis;
  foreach my $axis (@axis) {
    my ($proportion,$theta,$x,$y);

    if ($i > 0) {
      $proportion = $i / $number_of_axis;
      $theta = ((360 * $proportion) + $Theta) % 360;
      $axis->{theta} = $theta;
      $theta *= ((2 * $PI) / 360);
    } else {
      $axis->{theta} = $Theta;
      $theta = $Theta;
    }
    $x = cos $theta - (2 * $theta);
    $y = sin $theta - (2 * $theta);

    my $x_outer = ($x * $x_radius) + $x_centre;
    my $x_proportion =  ($x >= 0) ? $x : $x - (2 * $x) ;
    my $x_label = ($x_outer >= $x_centre) 
                    ? $x_outer + 3 
                    : $x_outer - ((length ( $axis->{Label} ) * 5) + (3 * $x_proportion));
    my $y_outer = ($y * $y_radius) + $y_centre;
    my $y_proportion =  ($y >= 0) ? $y : $y - (2 * $y) ;
    my $y_label = ($y_outer >= $y_centre) 
                    ? $y_outer + (3 * $y_proportion) 
                    : $y_outer - (9 * $y_proportion);

    $axis->{X} = $x;
    $axis->{Y} = $y;

    # round down coords
    $x_outer =~ s/(\d+)\..*/$1/;
    $y_outer =~ s/(\d+)\..*/$1/;
    $x_label =~ s/(\d+)\..*/$1/;
    $y_label =~ s/(\d+)\..*/$1/;

    # top label needs to be slightly offset to avoid the scale marking
    $y_label -= _font_offset($x_radius)  if($i == $number_of_axis);

    # draw axis and label
    if ($scale{Style} eq "Fill")  {
        push @Axis, [$x_outer, $y_outer, $x_centre, $y_centre, $colours{$scale{Colour}}];
        push @Label, [$x_label, $y_label, $axis->{Label}, $colours{$scale{Colour}}];      
    } else {
        $self->{_im}->line($x_outer, $y_outer, $x_centre, $y_centre, $colours{$scale{Colour}});
        $self->{_im}->string($self->{fonts}->{Label}, $x_label, $y_label, $axis->{Label}, $colours{$scale{Colour}});      
    }
    $i--;
  }

  # loop through adding scale, and values
  $r = 0;
  $i = 0;
  foreach my $axis (@axis) {
    my $x = $axis->{X};
    my $y = $axis->{Y};
    # draw scale
    my $theta1;
    my $theta2;
    if ($scale{Style} eq "Notch" || $scale{Style} eq "Fill")  {
      $theta1 = $axis->{theta} + 90;
      $theta2 = $axis->{theta} - 90;
      # convert theta to radians
      $theta1 *= ((2 * $PI) / 360);
      $theta2 *= ((2 * $PI) / 360);
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        my $x_interval = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
        my $y_interval = $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
        my $x1 = cos $theta1 - (2 * $theta1);
        my $y1 = sin $theta1 - (2 * $theta1);
        my $x2 = cos $theta2 - (2 * $theta2);
        my $y2 = sin $theta2 - (2 * $theta2);
        my $x1_outer = ($x1 * 3 * ($j / $scale{Max})) + $x_interval;
        my $y1_outer = ($y1 * 3 * ($j / $scale{Max})) + $y_interval;
        my $x2_outer = ($x2 * 3 * ($j / $scale{Max})) + $x_interval;
        my $y2_outer = ($y2 * 3 * ($j / $scale{Max})) + $y_interval;

        if($scale{Style} eq "Fill") {
          push @Notch, [$x1_outer,$y1_outer,$x_interval,$y_interval,$colours{$scale{Colour}}];
          push @Notch, [$x2_outer,$y2_outer,$x_interval,$y_interval,$colours{$scale{Colour}}];
        } else {
          $self->{_im}->line($x1_outer,$y1_outer,$x_interval,$y_interval,$colours{$scale{Colour}});
          $self->{_im}->line($x2_outer,$y2_outer,$x_interval,$y_interval,$colours{$scale{Colour}});
        }
      }
    }

    if ($scale{Style} eq "Polygon" || $scale{Style} eq "Fill")  {
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
        my $y_interval_1 = $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
        my $x_interval_2 = $x_centre + ($axis[$i-1]->{X} * ($x_radius / $scale{Max}) * $j);
        my $y_interval_2 = $y_centre + ($axis[$i-1]->{Y} * ($y_radius / $scale{Max}) * $j);

        if ($i > 0) {
          next if ($j == 0);
          $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colours{$scale{Colour}});
          if ($i == $number_of_axis -1) {
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $j);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $j);
            $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colours{$scale{Colour}});
          }
        }
      }
    }

    if ($scale{Style} eq "Circle")  {
      for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
        if ($i > 0) {
          next if ($j == 0);
          my $radius = (($y_radius * 2) / $scale{Max}) * $j;
          $self->{_im}->arc($x_centre,$y_centre,$radius,$radius,$axis[0]->{theta}-2,$axis[$i-1]->{theta}-2,$colours{$scale{Colour}});
          $self->{_im}->arc($x_centre,$y_centre,$radius,$radius,$axis[$i]->{theta}-2,$axis[0]->{theta}-2,$colours{$scale{Colour}});
        }
      }
    }

    # draw graph points
    if ($i != 0) {
      my $r = 0;
      foreach my $record (@{$self->{records}}) {
        my $value = $record->{Values}->{$axis->{Label}};
        my $colour = $colours{$record->{Colour}};
        $value ||= 0;
#print STDERR "Max=[$scale{Max}], value=[$value]"    if($self->{debug});
        my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $value);
        my $y_interval_1 = $y_centre + ($y * ($y_radius / $scale{Max}) * $value);

        if ($scale{Style} eq "Fill")  {
          push @{$record->{Points}}, [$x_interval_1,$y_interval_1];
          if ($i == $number_of_axis -1) {
            my $first_value  = $record->{Values}->{$axis[0]->{Label}};
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $first_value);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $first_value);
            push @{$record->{Points}}, [$x_interval_2,$y_interval_2];
          }
        } else {
          $self->draw_shape($x_interval_1,$y_interval_1,$colours{$record->{Colour}}, $r);

          my $last_value = $record->{Values}->{$axis[$i-1]->{Label}};
          my $x_interval_2 = $x_centre + ($axis[$i-1]->{X} * ($x_radius / $scale{Max}) * $last_value);
          my $y_interval_2 = $y_centre + ($axis[$i-1]->{Y} * ($y_radius / $scale{Max}) * $last_value);
          $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colour);

          if ($i == $number_of_axis -1) {
            my $first_value  = $record->{Values}->{$axis[0]->{Label}};
            my $x_interval_2 = $x_centre + ($axis[0]->{X} * ($x_radius / $scale{Max}) * $first_value);
            my $y_interval_2 = $y_centre + ($axis[0]->{Y} * ($y_radius / $scale{Max}) * $first_value);
            $self->{_im}->line($x_interval_1,$y_interval_1,$x_interval_2,$y_interval_2,$colour);
            $self->draw_shape($x_interval_2,$y_interval_2,$colours{$record->{Colour}}, $r);
          }
          $r++;
        }
      }
    }
    $i++;
  }

  # Fill is a filled polgon
  if ($scale{Style} eq "Fill")  {
    foreach my $record (@{$self->{records}}) {
      my $poly = GD::Polygon->new();
      $poly->addPt($_->[0],$_->[1]) for(@{$record->{Points}});
      $self->{_im}->filledPolygon($poly,$colours{$record->{Colour}});
    }

    $self->{_im}->line(@$_)                             for(@Axis,@Notch);
    $self->{_im}->string($self->{fonts}->{Label},@$_)   for(@Label);
  }

  # draw scale values
  my $x = $axis[0]->{X};
  my $y = $axis[0]->{Y};
  for (my $j = 0 ; $j <= $scale{Max} ; $j+=int($scale{Max} / $scale{Divisions})) {
    my $x_interval_1 = $x_centre + ($x * ($x_radius / $scale{Max}) * $j);
    my $y_interval_1= $y_centre + ($y * ($y_radius / $scale{Max}) * $j);
    $self->{_im}->string($self->{fonts}->{Legend}, $x_interval_1 + 2,$y_interval_1 - 4,$j,$colours{$scale{Colour}});
  }

  # draw Legend
  if($self->{legend}) {
    my $longest_legend = 0;
    foreach my $record (@{$self->{records}}) { 
      $longest_legend = length $record->{Label} 
        if ( $record->{Label} && length $record->{Label} > $longest_legend );
    }
    my ($legendX, $legendY) = (
           ($width / 2) - (6 * (length "Legend") / 2) - ($x_radius * 0.75),
           ($height - ($legend_height + 20))
    );
    $self->{_im}->string($self->{fonts}->{Legend},$legendX,$legendY,"Legend",$colours{$scale{Colour}});
    my $legendX2 = $legendX - (($longest_legend * 5) + 2);
    $legendY += 15;
    $r = 0;

    foreach my $record (@{$self->{records}}) {
      $self->{_im}->string($self->{fonts}->{Label},$legendX2,$legendY,$record->{Label},$colours{$record->{Colour}})  if($record->{Label});
      $self->{_im}->line($legendX+10,$legendY+4,$legendX + 35,$legendY+4,$colours{$record->{Colour}});
      $self->draw_shape($legendX+22,$legendY+4,$colours{$record->{Colour}},$r);
      $legendY += 15;
      $r++;
    }
  }

  # draw title
  if($self->{title}) {
      my ($titleX, $titleY) = ( ($width / 2) - (6 * (length $self->{title}) / 2),20);
      $self->{_im}->string($self->{fonts}->{Title},$titleX,$titleY,$self->{title},$colours{$scale{Colour}});
  }
  return 1;
}

sub png {
  my $self = shift;
  return    unless($self->{_im}->can('png'));
  return $self->{_im}->png();
}

sub jpg {
  my $self = shift;
  return    unless($self->{_im}->can('jpeg'));
  return $self->{_im}->jpeg(95);
}

sub gif {
  my $self = shift;
  return    unless($self->{_im}->can('gif'));
  return $self->{_im}->gif();
}

sub gd {
  my $self = shift;
  return    unless($self->{_im}->can('gd'));
  return $self->{_im}->gd();
}

##########################################################

sub draw_shape {
    my ($self,$x,$y,$colour,$i) = @_;
    my $shape;
    if (exists $self->{records}->[$i]->{Shape} ) {
        $shape = $self->{records}->[$i]->{Shape};
    } else {
        $shape = ($i > 4) ? int ($i % 5)  : $i ;
        $self->{records}->[$i]->{Shape} = $shape;
    }

    if ($shape == 0) {
        $self->draw_diamond($x,$y,$colour);
        return 1;
    }
    if ($shape == 1) {
        $self->draw_square($x,$y,$colour);
        return 1;
    }
    if ($shape == 2) {
        $self->draw_circle($x,$y,$colour);
        return 1;
    }
    if ($shape == 3) {
        $self->draw_triangle($x,$y,$colour);
        return 1;
    }
    if ($shape == 4) {
        $self->draw_cross($x,$y,$colour);
        return 1;
    }
}

sub draw_diamond {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+3,$y-3);
    $poly->addPt($x+6,$y);
    $poly->addPt($x+3,$y+3);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_square {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    $y-=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+6,$y);
    $poly->addPt($x+6,$y+6);
    $poly->addPt($x,$y+6);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_circle {
    my ($self,$x,$y,$colour) = @_;
    $self->{_im}->arc($x,$y,7,7,0,360,$colour);
    $self->{_im}->fillToBorder($x,$y,$colour,$colour);
    return 1;
}

sub draw_triangle {
    my ($self,$x,$y,$colour) = @_;
    $x-=3;
    $y+=3;
    my $poly = new GD::Polygon;
    $poly->addPt($x,$y);
    $poly->addPt($x+3,$y-6);
    $poly->addPt($x+6,$y);
    $poly->addPt($x,$y);
    $self->{_im}->filledPolygon($poly,$colour);
    return 1;
}

sub draw_cross {
    my ($self,$x,$y,$colour) = @_;
    $self->{_im}->line($x-3,$y,$x+3,$y,$colour);
    $self->{_im}->line($x,$y-3,$x,$y+3,$colour);
    return 1;
}

sub _font_size {
    my $scale  = shift || 1;
    my $radius = int((shift || $FONT[0]) / 100 );
    $radius = $FONT[0]  if($radius < $FONT[0]);
    $radius = $FONT[-1] if($radius > $FONT[-1]);

    return $FONT{$radius}->[$scale];
}

sub _font_offset {
    my $radius = int((shift || $FONT[0]) / 100 );

    return $FONT{$radius}->[0];
}

1;
__END__