#!/usr/bin/perl -w
use lib qw(blib/lib blib/arch);
use Imager;
use Imager::Plot;
use Time::Local;
Imager::Font->priorities(qw(w32 ft2 tt t1));
$plot = Imager::Plot->new(Width => 400,
Height => 350,
GlobalFont => get_font() );
$img = Imager->new(xsize=>450, ysize => 400);
$img->box(filled=>1, color=>'white');
@height = map { $_ + 15*(rand()-.5) } 100..180;
@weight = map { ($_)/3 + 35*(rand()-.5) } 100..180;
my ($minh, $maxh) = (sort {$a<=>$b} @height)[0,-1];
my ($a, $b) = ls_fit(\@height, \@weight);
@FIT = ([$minh, $a+$b*$minh], [$maxh, $a+$b*$maxh]);
$plot->AddDataSet(X=>\@height, Y=>\@weight, style=>{code=>{
ref=>\&bar_style,
opts=>undef}});
$plot->AddDataSet(XY=>\@FIT, style=>{line=>{color=>'red', antialias=>1}});
#$plot->AddDataSet(XY => \@tr, style=>{code=>{
# ref=>\&bar_style,
# opts=>undef
# }});
$Axis = $plot->GetAxis();
# this is mighty handy for time formating
$Axis->{YgridNum} = 8;
$Axis->{XgridNum} = 10;
$Axis->{Border} = "lb";
$Axis->{make_xrange} = sub {
$self = shift;
my $span = $self->{XDRANGE}->[1]-$self->{XDRANGE}->[0];
$self->{XRANGE} = [$self->{XDRANGE}->[0]-$span*0.05,
$self->{XDRANGE}->[1]+$span*0.05];
};
$Axis->{make_yrange} = sub {
$self = shift;
my $span = $self->{YDRANGE}->[1]-$self->{YDRANGE}->[0];
$self->{YRANGE} = [$self->{YDRANGE}->[0]-$span*0.2,
$self->{YDRANGE}->[1]+$span*0.2];
};
$plot->{'Ylabel'} = 'Weight [kg]';
$plot->{'Xlabel'} = 'Height [cm]';
$plot->{'Title'} = 'Scatter of Relation';
sub bar_style {
my ($DataSet, $xr, $yr, $Xmapper, $Ymapper, $img, $opts) = @_;
my @x = @$xr;
my @y = @$yr;
for (0..$#x) {
$img->box(color=>'blue', xmin=>$x[$_]-2, xmax=>$x[$_]+2, ymin=>$y[$_]-2, ymax=>$y[$_]+2, filled=>1);
}
}
$plot->Render(Image => $img, Xoff => 40, Yoff => 370);
mkdir("sampleout", 0777) unless -d "sampleout";
$img->write(file => "sampleout/sample8.ppm");
# find the coefficients for matching
# y = a+bx in the least squares sense to input data
sub ls_fit {
my @x = @{$_[0]};
my @y = @{$_[1]};
my $mx = mean(@x);
my $my = mean(@y);
my $varx = sum(map { $_*$_ } @x) - @x * $mx*$mx;
my $vary = sum(map { $_*$_ } @y) - @y * $my*$my;
my $covxy = sum(map { $x[$_]*$y[$_] } 0..$#x)-@x*$mx*$my;
my $b = $covxy / $varx;
my $a = $my - $b*$mx;
return ($a, $b);
}
sub sum {
my $t = 0;
$t+=$_ for @_;
$t;
}
sub mean {
return sum(@_)/@_;
}
sub get_font {
my %opts = (size=>12, color=>Imager::Color->new('black'));
my $font = Imager::Font->new(file=>"ImUgly.ttf", %opts)
|| Imager::Font->new(file=>"./dcr10.pfb", %opts);
die "Couldn't load any font!\n" unless $font;
return $font;
}