Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

POV-Ray graphing example

by oakbox (Chaplain)
on Sep 25, 2002 at 12:07 UTC ( #200603=note: print w/replies, xml ) Need Help??

in reply to Re: Re: Re: Drawing Graphs
in thread Drawing Graphs

Okay, this needs some explanation. This script was created to look into a directory storing files. Each of these Storable files has a hash reference for the results of tests. (This was part of the psychological profiling system I am working on for Each of these graphs takes between 5 and 30 seconds to render, so I was running this in the background as a cron job, pre-rendering the graphs so that when they are needed, they are already on the system and ready for download via the web.

How it works:
Pull up my values to graph (all results are between 1 and 9).
Send those values to the Builder.
The Builder tries to adjust the width of the bars to make them fit into the final image and then creates a POV source file.
After the source file is built, return to the main program and run a system call to create the png output file.

This was just a proof of concept. In the end, my customers weren't too happy with the look. It is very difficult (as mentioned earlier) to represent this kind of information in a clean way in 3D. Hopefully, you can use this code for some ideas and as a jumping-off point for your own code.

Note! I made a few changes to this code before posting it here and I haven't tested my changes. I can't guarantee the prettiness either :)

I put an example of the output (before fiddling with the source) here:

#!/usr/bin/perl use strict; no strict 'refs'; use Storable qw(retrieve nstore); my $dir = "/source/of/data/files/storable"; my $outputdir = "/dir/for/images/povtrace"; chdir $dir || (warn "Cannot chdir $dir: $!" and return); opendir(DIR, $dir) || (warn "Cannot open $dir: $!" and return); my @contents = readdir DIR; closedir(DIR); foreach my $f (@contents) { if($f !~ /candidateinfo/){ # not looking at candidates! my $file = $dir."/".$f; # the file # get test ID my ($can,$tg) = split(/-/,$f); if($can < 200){next;} # only recent candidates my ($tid,undef) = split(/\./,$tg); if($tid eq ""){next;} # filter kooky files my $Test = eval{retrieve($file)}; # read the storable my $scorecant; my @xdata; my @ydata; foreach my $tcode (sort keys %{$Test->{norms}}){ push(@xdata,$Test->{norms}->{$tcode}); push(@ydata,$Test->{expert_names}->{$tcode}); $scorecant .= "$Test->{norms}->{$tcode}"; } my $ccc = @ydata; if($ccc <1){next;} $ccc = @xdata; if($ccc <1){next;} my $outfile = "$outputdir/$tid-$scorecant.png"; if(-e($outfile)){ next; } # I've already graphed this result set # build the POV-Ray source file &Builder(\@xdata,\@ydata,"$tid-$scorecant.pov"); # Render that source file, the settings below are # a balance between speed and pretty my $povcall = qq( povray +L/home/oakbox/tmp/povray-3.5/include +A ++I$tid-$scorecant.pov +O$outfile +V +W400 +H300 +FN6); my $whang = system("$povcall 1>povray.stdout 2>povray.stderr"); } } exit; sub Builder { my ($xdata,$ydata,$renderfilename) = @_; my @xdata; my @ydata; my $number_vert_lines = 9; # this is a kludge, but I'm in a hurry foreach ( @{$xdata} ){ push(@xdata,$_);} foreach ( @{$ydata} ){ push(@ydata,$_);} # make sure that I have an x for every y my $county = @ydata; my $countx = @xdata; if($countx ne $county){ die "Your x and y counts don't add up!"; } # find height scaling factor my $maxyval = 9 ; my $heightscale = 4 / $maxyval; my $ylabels; foreach my $level (0...$number_vert_lines){ my $label = ($level/$number_vert_lines) * $maxyval; $label = sprintf("%.1f", $label); my $lineup = ($level/$number_vert_lines) * 4; $ylabels .= qq( text { ttf "Arial.ttf" "$label" .1, 0 pigment { Black } scale .15 translate <-.7,$lineup,0> rotate <0,350,0> } object { Divide_Line translate <-.5,$lineup,0>} ); } # calculate dividers and bar width my $widthval = 6 / $county; if($widthval > 2){$widthval=2;} my $yspace = $widthval * .8; # make bar declarations one for each y value my @colorseq = ("Blue","Green","Red","Blue","Green","Red","Blue","Gree +n","Red","Blue","Green","Red","Blue","Green","Red","Blue","Green","Re +d","Blue","Green","Red","Blue","Green","Red","Blue","Green","Red","Bl +ue","Green","Red","Blue","Green","Red","Blue","Green","Red","Blue","G +reen","Red","Blue","Green","Red","Blue","Green","Red","Blue","Green", +"Red","Blue","Green","Red","Blue","Green","Red","Blue","Green","Red", +"Blue","Green","Red","Blue","Green","Red"); my $bar_descriptors; my $tscale_factor = ".01"; my $scale_factor = .20; my $theight = -.15; foreach my $placeh (0...$#ydata){ my $barheight = $xdata[$placeh] * $heightscale; $barheight = sprintf("%.2f", $barheight); my $yplace = $placeh * $widthval; $yplace = sprintf("%.2f", $yplace); my $interior_lights; foreach my $lights (0){ # only one light now, but easy to add! if($lights < $barheight){ my $bong = $lights + .1; $interior_lights.=qq( light_source { <.1,$bong,.2> color White } ); }} my $tplace = $yplace + ($yspace/2); $bar_descriptors.=qq( #declare Bar_$placeh = merge { cylinder { <0,$barheight,0>, <0,0,0>, .2 finish { Dull } pigment { $colorseq[$placeh] filter .5} interior{ ior 1.5 fade_distance 5 fade_power .5 caustics 1 } } $interior_lights bounded_by { box {<0,0,0>, <$yspace,$barheight,1>} } } object { Bar_$placeh translate <$yplace,0,0> } text { ttf "Arial.ttf" "$ydata[$placeh]" .15, 0 pigment { $colorseq[$placeh] } scale $scale_factor translate <.15,$theight,0> rotate <0,20,350> translate <$tplace,0,0> } ); # $scale_factor = $scale_factor + $tscale_factor; # $theight = $theight + $tscale_factor; } my $final_output = qq( #include "" #include "" camera { location <.7,2.5,-6.5> look_at <2.4,1.9,0> } background { White } global_settings { max_trace_level 30 } light_source { <0, 50, -50> color White shadowless } #declare Divide_Line = box { <0,0,-.1>, <7,-.015,-.12> pigment { Gray05 } } $ylabels $bar_descriptors ); open (WRT,">$renderfilename"); print WRT $final_output; close(WRT); } exit;


Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://200603]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (3)
As of 2020-07-10 07:08 GMT
Find Nodes?
    Voting Booth?

    No recent polls found