expresspotato has asked for the wisdom of the Perl Monks concerning the following question:

Hi, It seems GD::Graph's overwrite attribute pays no attention to which bar seems to be longer. It seems to write the bars ontop of one another with no respect for which is bigger. Smaller bars aren't even shown. Does anyone know of a workaround?

Replies are listed 'Best First'.
Re: GD::Graph Overwrite
by chrestomanci (Priest) on Jan 14, 2011 at 20:54 UTC

    GD::Graph is basically a bunch of special purpose drawing primitives for GD, which just draws pixels onto a bitmap. In other words, if you ask GD::Graph to put a bar 5 units high at point 7 of the Y axis, it will push pixels to do exactly that, regardless of what pixels where there before.

    With that in mind, I think you need to process your data a bit more before you plot it.

      No I can't sort the data first as it is being used on a bar chart where the x-axis is the date. Some sort of sort needs to actually go on within GD::Graph to sort the columns before drawing them.
      use GD::Graph::lines; use GD::Graph::bars; $suffix = @ARGV[0]; #Suffix $accur = @ARGV[1]; #Accuracy $mode = @ARGV[2]; #Mode (se - start/end or fd - full day) if ($accur eq "" || $suffix eq ""){print "Usage: perl WAC.pl [suffix] +[hour minute] <fd se>"; exit;} ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time +); $year = $year+1900; $hour = sprintf("%.2d",$hour); $min = sprintf("%.2d",$min); $sec = sprintf("%.2d",$sec); @plot_legend = ('Exceptions','Successes','WAC_002','Errors'); &check_usage(); &read_data(); &date_setup(); &date_hash(); &parse_data(); &plot_prepare(); &plot_graph(); print "Graph OK\n"; sub plot_prepare(){ foreach (sort(keys %date_plots)){ push(@plots_date,$_); push(@plots_exception,$exception{$_}); push(@plots_success,$success{$_}); push(@plots_wac,$wac{$_}); push(@plots_error,$error{$_}); #print "$_ -> $success{$_}\n"; } } sub parse_data(){ my %line; foreach (@data){ chomp($_); %line = &return_data($_); #print "$line{date_string}\n"; if ($l_msg =~ "Exception"){$exception{$line{date_string}} = $l +ine{l_count};} if ($l_msg =~ "Success"){$success{$line{date_string}} = $line{ +l_count};} if ($l_msg =~ "wac_002"){$wac{$line{date_string}} = $line{l_co +unt};} if ($l_msg =~ "Errorcode" && $l_msg !~ "wac_002"){$error{$line +{date_string}} = $line{l_count};} } } sub date_setup(){ %d_first = &return_data(@data[0]); %d_last = &return_data(@data[$#data]); print "First date: $d_first{month}/$d_first{day} $d_first{hour}:$d +_first{min}\n"; print "Last date: $d_last{month}/$d_last{day} $d_last{hour}:$d_las +t{min}\n"; } sub date_hash(){ print "Accuracy is $accur\n"; my $l_min,$l_hr,$l_mon,$l_day; my $t_min,$t_hr,$t_mon,$t_day; $t_mon = sprintf("%.2d",$d_first{month}); $t_day = $d_first{day}; if ($mode eq "fd"){ $t_hr = 0; $t_min = 0; } else{ $t_hr = $d_first{hour}; $t_min = $d_first{min}; } $l_date_min = sprintf("%.2d", $l_date_min); $l_date_hr = sprintf("%.2d", $l_date_hr); $l_date_day = sprintf("%.2d", $l_date_day); $l_date_month = sprintf("%.2d", $l_date_month); while ($t_mon <= $d_last{month}){ while ($t_day <= $d_last{day} || ($t_mon < $d_last{month} && $ +t_day <= 31)){ while ($t_hr <= 23){ if ($accur eq "minute"){ while ($t_min <= 59){ unless ($t_day eq $d_last{day} && $t_hr > $d_las +t{hour} && $mode ne "fd"){ unless ( ($t_min > $d_last{min} && $t_hr >= $d +_last{hour}) && $mode ne "fd"){ #print "Add:" . sprintf("%.2d",$t_mon). "/ +" . sprintf("%.2d",$t_day) . " " . sprintf("%.2d",$t_hr) . ":" . spri +ntf("%.2d",$t_min) . "\n"; $date_plots{sprintf("%.2d",$t_mon). "/" . +sprintf("%.2d",$t_day) . " " . sprintf("%.2d",$t_hr) . ":" . sprintf( +"%.2d",$t_min)}=0; } } $t_min++; } $t_min = 0 }elsif($accur eq "hour"){ unless ($t_day eq $d_last{day} && $t_hr > $d_last{ +hour}){ $date_plots{sprintf("%.2d",$t_mon). "/" . spri +ntf("%.2d",$t_day) . " " . sprintf("%.2d",$t_hr) . ":00"}=0; } } $t_hr++; $t_min = 0; } $t_hr = 0; $t_day++; } $t_mon++; $t_day = 1; } } sub check_usage(){ if ($accur eq "" || $suffix eq ""){ print "Usage: perl WAC.pl [suffix] [hour minute]"; exit; } } sub read_data(){ print "Reading...\n"; open(HANDLE,"./$suffix\_$accur.txt") || die $!; @data = <HANDLE>; close(HANDLE); } sub return_data(){ my $line = $_[0]; my $date; my $return_hash; #print "$line\n"; ($l_date,$l_count,$l_msg) = split(/\t/,$line); ($l_date_a,$l_date_b,$date_c) = split(/ /,$l_date); ($l_date_month,$l_date_day,$extra_date) = split(/\//,$l_date_a); ($l_date_hr,$l_date_min,$extra_time) = split(/\:/,$l_date_b); if ($l_date_hr eq ""){$l_date_hr = "00";} if ($l_date_min eq ""){$l_date_min = "00";} if ($date_c eq "PM" && $l_date_hr != 12){$l_date_hr += 12;} $l_date_min = sprintf("%.2d", $l_date_min); $l_date_hr = sprintf("%.2d", $l_date_hr); $l_date_day = sprintf("%.2d", $l_date_day); $l_date_month = sprintf("%.2d", $l_date_month); $return_hash{l_count} = $l_count; $return_hash{l_msg} = $l_msg; $return_hash{month} = $l_date_month; $return_hash{day} = $l_date_day; $return_hash{hour} = $l_date_hr; $return_hash{min} = $l_date_min; $return_hash{date_string} = "$l_date_month/$l_date_day $l_date_hr: +$l_date_min"; return %return_hash; } sub plot_graph(){ @data = ( \@plots_date, \@plots_exception, #Red \@plots_success, #Green \@plots_wac, #Yellow \@plots_error, #? ); my $graph = GD::Graph::bars->new(1000,700); $graph->set( correct_width => 0, x_label => 'Days', y_label => 'WAC service response', title => "WAC Service Call Results as of: $mon/$ +mday/$year $hour:$min:$sec", t_margin => 10, b_margin => 10, l_margin => 10, r_margin => 100, #x_label_skip => sprintf("%.0d",$#plots_date / 12), show_values => 0, x_label_position => 0.50, y_label_position => 0.50, x_labels_vertical => 1, y_long_ticks => 1, #line_types => [1,1,1], #skip_undef => 1, boxclr => 'white', fgclr => 'gray', #bar_width => 1, accent_treshold => 1, #cumulate => 1, #show_values => 1, overwrite => 1, axislabelclr => 'black', dclrs => [ qw(red green blue orange) ] ) or die $graph->error; $graph->set_text_clr('black'); if ($accur eq "hour"){ print $#plots_date; if ($#plots_date == 24){$graph->set(x_label_skip=>1);} elsif ($#plots_date <= 200){$graph->set(x_label_skip=>8);} else{$graph->set(x_label_skip=>64);} } if ($accur eq "minute"){ $graph->set(x_label_skip=>$#plots_date/24); } $graph->set_legend(@plot_legend); $graph->set_legend_font(GD::gdMediumBoldFont); $graph->set_title_font(GD::gdMediumBoldFont); my $gd = $graph->plot(\@data) or die $graph->error; open(IMG, ">./$suffix\_$accur.png") or die $!; binmode IMG; print IMG $gd->png; }
Re: GD::Graph Overwrite
by Anonymous Monk on Jan 14, 2011 at 18:57 UTC

    Is it possible to sort the values by size before passing them to the graphing code?

      That is exactly how I solved this problem in the past.
      My code is posted above, if you know a way of sorting the order for each bar to be drawn for each time period please let me know
Re: GD::Graph Overwrite
by zentara (Cardinal) on Jan 14, 2011 at 20:01 UTC
    Got some code to show? I, for one, have no idea of what you are trying to do, except "print on top of a previous image". Maybe clear out old GD object, print an empty graph, then print with new data?

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh