Beginner wrote:
Hi,
I am trying to create a line graph with GD::Graph::Lines.
I have data being passed by CGI in the format:
"ancode_1" = "ADV "
"ADV_2006" = "117216 "
"ADV_2005" = "104776 "
"ancode_2" = "BAP "
"BAP_2006" = "0 "
"BAP_2005" = "270 "
"ancode_3" = "BOO "
"BOO_2006" = "746854 "
"BOO_2005" = "673151 "
"ancode_4" = "BUS "
"BUS_2006" = "0 "
"BUS_2005" = "2476 "
"ancode_5" = "COM "
"COM_2006" = "87787 "
"COM_2005" = "97009 "
The number of years can vary so you might get data from 2006->1990.
The data looks like it is suited to a hash but GD::lines wants the
data passed to in as arrays references ([EMAIL PROTECTED]). That is one array
with all the "ancode_n" and foreach code, an array of all the yearly
values. I have managed to get my data into this type of structure
'ADV ' => [
'117216',
'104776',
]
'BAP ' => [
'0',
'270',
],
But I am stuck trying to get it out into n number of arrays that I
can pass to GD. I don't want to pre-declare n number of arrays as the
number may vary and because I am using strict, I don't know how I can
pass the data out of whatever loop I use to get to the values.
my $gd = GD::Graph::lines->new(600,400);
my @data = ([EMAIL PROTECTED],[EMAIL PROTECTED], a number of arrays equal to
size of
@ancodes);
This is the bit of code I use to generate the hash of arrays
use GD::Graph::hbars;
use GD::Graph::lines;
use GD::Graph::Data;
use CGI qw/:standard/;
use Data::Dumper;
use strict;
use warnings;
my $q = new CGI;
my @par_names = $q->param;
my (@cl_type,@values,@years,);
my %yrs;
my $current_code;
for (my $i = 0; $i < $#par_names; ++$i) {
if ($par_names[$i] =~ /ancode_\d+/) {
$current_code = $q->param($par_names[$i]);
push(@cl_type,$q->param($par_names[$i]) );
}
if ($par_names[$i] =~ /\w{3}_\d{4}/) {
(my $y) = ($par_names[$i] =~ /\w{3}_(\d{4})/);
if (! exists($yrs{$y}) ) { # only accept yrs not
seen.
$yrs{$y} = 0;
}
my $val = $q->param($par_names[$i]);
(my $value = $val) =~ s/\s+$//;
push @{$values{$current_code}},$value;
}
}
Can someone offer me some pointers here? I am struggling to do this
and I expect there is a short-hand way to achieve what I want.
Hi Dermot
You're getting confused aren't you! A big problem is that you're losing the data
x-values (the years) as you process the CGI parameter list. You need a hash of
hashes that relates each ancode to a list of years and their corresponding
values.
It looks to me as if there's no need to process the ancode parameter values, as
all they tell you is the code for the following data, which is in the parameter
name anyway. Something like this:
my %values;
foreach my $par ($q->param) {
if ($par =~ /(\w{3})_(\d{4})/ ) {
my ($ancode, $yr) = ($1, $2);
$values{$ancode}{$yr} = $q->param($par);
}
}
puts the data into a structure like I've described and I think is self-
explanatory.
One other thing, your line
my @data = ([EMAIL PROTECTED],[EMAIL PROTECTED], a number of arrays equal to
size of @ancodes);
can't work as @ancodes is a list of labels for the data sets when it needs to be
a set of y-values corresponding to the x-values (years) in the first parameter;
you need to add these separately with set_legend.
The complete code below works for me: see what you think.
HTH,
Rob
use strict;
use warnings;
use GD::Graph::lines;
use GD::Graph::Data;
use CGI qw/:standard/;
my $q = new CGI;
my %values;
foreach my $par ($q->param) {
my $val = $q->param($par);
$val =~ s/\s+$//;
if ($par =~ /(\w{3})_(\d{4})/ ) {
my ($ancode, $yr) = ($1, $2);
$values{$ancode}{$yr} = $val;
}
}
my @ancodes = sort keys %values;
my %years;
foreach my $ancode (@ancodes) {
my $data = $values{$ancode};
@years{keys %$data} = ();
}
my $gdata = new GD::Graph::Data;
my @data = @[EMAIL PROTECTED];
foreach my $yr (sort keys %years) {
$gdata->add_point($yr, map $_->{$yr}, @data);
}
my $graph = GD::Graph::lines->new(600, 400);
$graph->set_legend(@ancodes);
my $gd = $graph->plot($gdata);
open my $fh, '> plot.gif' or die $!;
binmode $fh;
print $fh $gd->gif;
close $fh;
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
