Okay, this needs some explanation. This script was created to look into a directory storing Storable.pm 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 http://www.iscreen.nl.) 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:
http://www.oakbox.com/povexamp.png
#!/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 "colors.inc"
#include "finish.inc"
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;
oakbox | [reply]
[d/l] |
