package LIMS::Controller::Roles::Chart;
use Moose::Role;
with 'LIMS::Role::Base'; # format_first_name
use Image::Dot;
use Data::Dumper;
sub cleardot { # returns 1px x 1px transparent dot image
my $self = shift;
return dot_PNG_RGBA(0, 0, 0, 0);
}
# ------------------------------------------------------------------------------
sub pie_simple {
my $self = shift;
my $data = $self->_get_chart_data();
# The colors to use for the sectors
my $colors = [0x66ff66, 0xff6666, 0xffff00];
# Create a PieChart object of size 300 x 300 pixels. Set the background to a gradient
# color from blue (aaccff) to sky blue (ffffff), with a grey (888888) border. Use
# rounded corners and soft drop shadow.
my $c = new PieChart(300, 300);
my $bgd = $c->linearGradientColor(0, 0, 0, $c->getHeight() / 2, 0xaaccff, 0xffffff);
$c->setBackground($bgd, 0x888888);
$c->setRoundedFrame();
$c->setDropShadow();
if ( 0 ) {
# Set the center of the pie at (150, 150) and the radius to 120 pixels
$c->setPieSize(150, 150, 120);
# Set the label position to -40 pixels from the perimeter of the pie (-ve means
# label is inside the pie)
$c->setLabelPos(-40);
} else {
# Set the center of the pie at (150, 150) and the radius to 80 pixels
$c->setPieSize(150, 150, 80);
# Set the sector label position to be 20 pixels from the pie. Use a join line to
# connect the labels to the sectors.
$c->setLabelPos(20, $perlchartdir::LineColor);
}
# Set the pie data and the pie labels
$c->setData($data->{values}, $data->{labels});
# Set the sector colors
$c->setColors2($perlchartdir::DataColor, $colors);
# Use local gradient shading, with a 1 pixel semi-transparent black (bb000000) border
$c->setSectorStyle($perlchartdir::LocalGradientShading, 0xbb000000, 1);
return $c;
}
# ------------------------------------------------------------------------------
sub horizontal_linear_meter {
my $self = shift;
my $vars = shift; # warn Dumper $vars;
# don't want arrayref format from _get_chart_data():
my $chart_data = $self->stash->{chart_data}; # warn Dumper $chart_data;
my $type = $vars->{type};
my $data;
if ( $type =~ /\Ablocks_(\w+)/ ) { # disk space request:
my $vol = ($1 eq 'root') ? '' : $1; # depicted as "/$vol" in legend
my $disk = 100 * $chart_data->{blocks_used} /
($chart_data->{blocks_used} + $chart_data->{blocks_free});
$data = {
total => $chart_data->{blocks_used} + $chart_data->{blocks_free},
used => $chart_data->{blocks_used},
legend => sprintf q!Disk space used ('/%s') %.1f%%!, $vol, $disk,
}
}
elsif ( $type eq 'real_mem' ) { # system memory request:
my $mem = 100 * ($chart_data->{memtotal} - $chart_data->{memfree})
/ $chart_data->{memtotal}; # total - free / total (%)
$data = {
total => $chart_data->{memtotal},
used => $chart_data->{memtotal} - $chart_data->{memfree},
legend => sprintf 'Real memory used %.1f%%', $mem,
};
}
elsif ( $type eq 'swap_mem' ) { # system swap memory request:
my $swap_used = $chart_data->{swaptotal} - $chart_data->{swapfree};
my $mem = $chart_data->{swaptotal} # fix for Deb6 VM - doesn't load swap ???
? 100 * $swap_used / $chart_data->{swaptotal} # total - free / total (%)
: 0;
$data = {
total => $chart_data->{swaptotal},
used => $chart_data->{swaptotal} - $chart_data->{swapfree},
legend => sprintf 'Virtual memory used %.1f%%', $mem,
};
}
my $used = $data->{used};
my $total = $data->{total};
my $legend = $data->{legend};
# Create an LinearMeter object of size 250 x 75 pixels, using silver background with
# a 2 pixel black 3D depressed border.
my $m = new LinearMeter(250, 75, perlchartdir::silverColor(), 0, -2);
# Set the scale region top-left corner at (15, 25), with size of 200 x 50 pixels. The
# scale labels are located on the top (implies horizontal meter)
$m->setMeter(15, 25, 220, 20, $perlchartdir::Top);
# Set meter scale from 0 - $total, with 5 zones
$m->setScale(0, $total, int 100 * $total / 500);
# Set 0 - 60% as green (99ff99) zone, 60 - 80% as yellow (ffff66) zone, and
# 80 - 100% as red (ffcccc) zone
$m->addZone(0, $total * .6, 0x99ff99);
$m->addZone($total * .6, $total * .8, 0xffff66);
$m->addZone($total * .8, $total, 0xffcccc);
# Add a blue (0000cc) pointer at the specified value
$m->addPointer($used, 0x0000cc);
# Add a label at bottom-left (10, 68) using Arial Bold/8 pts/red (c00000)
$m->addText(10, 68, $legend, "arialbd.ttf", 8, 0xc00000,
$perlchartdir::BottomLeft);
# Add a text box to show the value formatted to 1 decimal place at bottom right. Use
# white text on black background with a 1 pixel depressed 3D border.
$m->addText(238, 70, $m->formatValue($used, 1), "arial.ttf", 8, 0xffffff,
$perlchartdir::BottomRight)->setBackground(0, 0, -1);
return $m;
}
# ------------------------------------------------------------------------------
sub soft_bar {
my $self = shift;
my $data = $self->_get_chart_data();
# Create a XYChart object of size 600 x 360 pixels
my $c = new XYChart(600, 360);
# Set the plotarea at (60, 40) and of size 500 x 280 pixels. Use a vertical gradient
# color from light blue (eeeeff) to deep blue (0000cc) as background. Set border and
# grid lines to white (ffffff).
$c->setPlotArea(60, 40, 500, 280, $c->linearGradientColor(60, 40, 60, 280, 0xeeeeff,
0x0000cc), -1, 0xffffff, 0xffffff);
# Add a multi-color bar chart layer using the supplied data. Use soft lighting effect
# with light direction from left.
$c->addBarLayer3($data->{values})->setBorderColor($perlchartdir::Transparent,
perlchartdir::softLighting($perlchartdir::Left));
# Set x axis labels using the given labels
$c->xAxis()->setLabels($data->{labels});
# Draw the ticks between label positions (instead of at label positions)
$c->xAxis()->setTickOffset(0.5);
# Add a title to the y axis with 16pts Arial Bold font
if ( my $label = $self->stash->{y_axis_label} ) {
$c->yAxis()->setTitle($label, 'arialbd.ttf', 12);
}
# Set axis label style to 8pts Arial Bold
# $c->xAxis()->setLabelStyle("arialbd.ttf", 8);
# $c->yAxis()->setLabelStyle("arialbd.ttf", 8);
# Set axis line width to 2 pixels
$c->xAxis()->setWidth(2);
$c->yAxis()->setWidth(2);
return $c;
}
# ------------------------------------------------------------------------------
sub simple_line {
my $self = shift;
my $data = $self->_get_chart_data();
# Create a XYChart object of size 250 x 250 pixels
my $c = new XYChart(700, 300);
# Set the plotarea at (30, 20) and of size 200 x 200 pixels
$c->setPlotArea(60, 20, 580, 200);
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
$layer->addDataSet($data->{values}, 0xcf4040)->setDataSymbol(
$perlchartdir::DiamondSymbol, 7);
# Set the labels on the x axis.
$c->xAxis()->setLabels($data->{labels}); # warn Dumper $data->{labels};
# TODO: do this automatically ?
my $label_count = @{ $data->{labels} };
if ($label_count > 25) {
my $step = int ( $label_count / 13 ); # so max labels = 25
$c->xAxis->setLabelStep($step);
}
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000)->setFontAngle(-45);
return $c;
}
# ------------------------------------------------------------------------------
sub cylinder_bar_shape {
my $self = shift;
my $data = $self->_get_chart_data();
# Create a XYChart object of size 400 x 240 pixels.
my $c = new XYChart(600, 300);
# Set the plotarea at (45, 40) and of 300 x 160 pixels in size. Use alternating light
# grey (f8f8f8) / white (ffffff) background.
$c->setPlotArea(65, 40, 480, 200, 0xf8f8f8, 0xffffff);
# Add a multi-color bar chart layer
my $layer = $c->addBarLayer3($data->{values});
# Set layer to 3D with 10 pixels 3D depth
$layer->set3D(10);
# Set bar shape to circular (cylinder)
$layer->setBarShape($perlchartdir::CircleShape);
# Set the labels on the x axis.
$c->xAxis()->setLabels($data->{labels});
# Add a title to the y axis with 16pts Arial Bold font
if ( my $label = $self->stash->{y_axis_label} ) {
$c->yAxis()->setTitle($label, 'arialbd.ttf', 12);
}
return $c;
}
# ------------------------------------------------------------------------------
sub overlapping_bar_chart {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $sample_types = $data->{points};
# initialise data structure:
my %data = ();
{ # sort $data->{values} AoA into %data hash:
my $values = $data->{values}; # warn Dumper $values;
for my $row (@$values) { # $row = arrayref:
# foreach sample_type, get corresponding frequency value:
for my $i (0 .. @$sample_types -1) { # warn $i;
my $sample_type = $sample_types->[$i];
my $result = $self->_parse_data_val($row->[$i]);
push @{ $data{$sample_type} }, $result; # warn Dumper [$sample_type, $row->[$i], $result];
}
# final value is cumulative total:
push @{ $data{total} }, $self->_parse_data_val($row->[-1]);
}
} # warn Dumper \%data;
# Create a XYChart object of size 580 x 280 pixels
my $c = new XYChart(600, 280);
# Add a title to the chart using 14 pts Arial Bold Italic font
# $c->addTitle("Product Revenue For Last 3 Years", "arialbi.ttf", 14);
# Set the plot area at (50, 50) and of size 500 x 200. Use two alternative background
# colors (f8f8f8 and ffffff)
$c->setPlotArea(50, 50, 500, 200, 0xf8f8f8, 0xffffff);
# Add a legend box at (50, 25) using horizontal layout. Use 8pts Arial as font, with
# transparent background.
$c->addLegend(50, 25, 0, "arial.ttf", 8)->setBackground($perlchartdir::Transparent);
# Set the x axis labels
$c->xAxis()->setLabels($data->{labels});
# Draw the ticks between label positions (instead of at label positions)
$c->xAxis()->setTickOffset(0.5);
# Add a multi-bar layer with 3 data sets
my $layer = $c->addBarLayer2($perlchartdir::Side);
{ # assign colors to datasets:
my $i = 0;
my @c = ( 0xff8080, 0x8080ff, 0x80ff80 );
$layer->addDataSet( $data{$_}, $c[$i++], $_ ) for @$sample_types;
}
# Set 60% overlap between bars
$layer->setOverlapRatio(0.6);
# add data for secondary y axis:
my $layer2 = $c->addLineLayer();
$layer2->addDataSet($data{total}, 0xc00000)
->setDataSymbol($perlchartdir::GlassSphere2Shape, 11);
$layer2->setDataLabelFormat("{value}"); # same as {value|0}
$layer2->setUseYAxis2();
$layer2->setLineWidth(2);
# Add a title to the secondary (right) y axis
$c->yAxis2()->setTitle("no. of reports (total)");
$c->yAxis2()->setColors(0xc00000, 0xc00000, 0xc00000);
# Add a title to the y-axis
$c->yAxis()->setTitle("no. of reports (by sample type)");
return $c;
}
# ------------------------------------------------------------------------------
sub plot_outreach {
my ($self, $params) = @_; # params = arrayref of data params in required order
my $data = $self->_get_chart_data(); # warn Dumper $data;
my %h = (); # initialise data structure for params
{ # sort $data->{values} AoA into %data hash:
my $values = $data->{values}; # warn Dumper $values;
for my $row (@$values) { # $row = arrayref:
# log scale range set 1 - 1000, so need to set vals <1 to null ??:
# map { $_ = undef if $_ < 1 } @$row;
my $i = 0; # param position counter for $row
for my $p (@$params) {
push @{ $h{$p} }, $self->_parse_data_val($row->[$i++]);
}
}
} # warn Dumper \%h;
# delete $h{param} dataset if no usable vals:
for my $param (keys %h) { # warn Dumper [$_, $h{$_}];
delete $h{$param} unless grep { $_ && $_ ne $perlchartdir::NoValue }
@{ $h{$param} }; # delete if all dataset vals either 0 or NULL
} # warn Dumper \%h;
# minimum y-val depends on params:
my $min_y_val = ( grep $_ eq 'abnormal_b_cells', @$params ) ? 0.1 : 1;
# force minimum val to $min_val for abnormal_b_cells (if exists):
map { $_ = $min_y_val if $_ && $_ < $min_y_val } @{ $h{abnormal_b_cells} }
if $h{abnormal_b_cells}; # or it will auto-vivify if not exists
my $c = new XYChart(360, 320); # needs to fit x2 on A4 when printed
# Set the plotarea at (n1, n2) and of size n3 x n4 pixels, with white background.
# Turn on both horizontal and vertical grid lines with light grey color (0xcccccc)
$c->setPlotArea(48, 38, 250, 220, 0xffffff, -1, -1, 0xcccccc, 0xcccccc);
# ->setBackground(0xffffff, 0xe0e0e0); # doesn't look good
# Add a legend box at (50, 30) (top of the chart) with horizontal layout. Use 9 pts
# Arial Bold font. Set the background and border color to Transparent.
$c->addLegend(20, 0, 0, "arialbd.ttf", 9)
->setBackground($perlchartdir::Transparent);
my $yAxis_title = join ' / ', grep { $_ !~ /hb|bcr_abl/ } @$params;
$yAxis_title =~ s/_/ /g;
# Set the labels on the x axis.
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000); # ->setFontAngle(-45);
# set Y axis - if any datasets (skip params hb & bcr_abl with their own axis):
if ( grep { $h{$_} } grep { $_ !~ /^(hb|bcr_abl)$/ } @$params ) {
$c->yAxis()->setTitle(uc $yAxis_title);
$c->yAxis()->setLogScale($min_y_val, 1000); # set range (min & max vals)
}
{ # 1st layer:
my $layer = $c->addLineLayer();
$layer->setXData($data->{labels});
# these affect all layer lines - see perldemo\missingpoints.pl for separate layers
$layer->setGapColor($c->dashLineColor(0x000000));
$layer->setLineWidth(2);
# outreach common params:
$layer->addDataSet( $h{wbc}, 0xff6600, 'WBC' )
->setDataSymbol( $perlchartdir::TriangleShape, 7) if $h{wbc};
$layer->addDataSet( $h{plts}, 0x006633, 'Plts' )
->setDataSymbol( perlchartdir::StarShape(5), 10 ) if $h{plts};
$layer->addDataSet( $h{creatinine}, 0x0000ff, 'Creatinine' )
->setDataSymbol( $perlchartdir::CircleSymbol, 6) if $h{creatinine};
# outreach other params:
$layer->addDataSet( $h{paraprotein}, 0xff6600, 'Paraprotein' )
->setDataSymbol( $perlchartdir::DiamondShape, 7) if $h{paraprotein};
$layer->addDataSet( $h{abnormal_b_cells}, 0x66ff00, 'Abnormal B cells' )
->setDataSymbol( $perlchartdir::GlassSphere2Shape, 7 )
if $h{abnormal_b_cells};
}
if ( $h{hb} ) { # Hb to its own layer + axis:
$c->yAxis2()->setTitle("Hb (g/L)");
$c->yAxis2()->setColors(0xcc0000, 0xcc0000, 0xcc0000);
$c->yAxis2()->setLinearScale(50, 200); # set range (min & max vals)
my $layer = $c->addLineLayer();
$layer->setXData($data->{labels});
$layer->setUseYAxis2;
$layer->setGapColor($c->dashLineColor(0xff0000));
$layer->setLineWidth(2);
$layer->addDataSet( $h{hb}, 0xff0000, 'Hb' )
->setDataSymbol( $perlchartdir::SquareSymbol, 7 );
}
# bcr-abl called direct via chart/imatinib, not as outreach param
if ( $h{bcr_abl} ) { # BCR-ABL to its own layer + axis:
$c->yAxis2()->setTitle("BCR-ABL ratio");
$c->yAxis2()->setColors(0xff0000, 0xff0000, 0xff0000);
$c->yAxis2()->setLogScale(.0001, 1000);
my $layer = $c->addLineLayer();
$layer->setXData($data->{labels});
$layer->setUseYAxis2;
$c->yAxis2()->addMark(0.055, 0x000000, 'MMR')->setLineWidth(2);
$c->yAxis2()->addMark(55, 0x000000, '55%')->setLineWidth(2);
$layer->setGapColor($c->dashLineColor(0x000000));
$layer->setLineWidth(1);
$layer->addDataSet( $h{bcr_abl}, 0xff0000, 'BCR-ABL' )
->setDataSymbol( $perlchartdir::CircleShape, 6 );
}
# configure x-axis label format
$self->_configure_date_axis($c);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_outreach_param {
my $self = shift;
my $data = $self->_get_chart_data();
# extract labels & vals:
my $labels = $data->{labels};
my $values = $data->{values}; # warn Dumper $values;
# adjust vals to 3sf, set any nulls to $perlchartdir::NoValue:
for (@$values) {
$_ = (defined $_)
? LIMS::Local::Utils::sig_figs($_) # OR use format_sig_figs($_, 3)
: $perlchartdir::NoValue;
} # warn Dumper $values;
my $width = 400; # default width
if ($self->stash->{dynamic_adjust}) { # can dynamically adjust chart width:
$width *= ( @$values / 10 ) if @$values > 10; # increase width if n >10
} # warn $width;
my $c = new XYChart($width, 250);
$c->setPlotArea(31, 21, $width - 70, 170, 0xffffc8);
my $layer = $c->addLineLayer();
$layer->addDataSet($values, 0x0000ff)->setDataSymbol(
$perlchartdir::CircleSymbol, 4);
$layer->setDataLabelFormat("{value}");
$layer->setGapColor($c->dashLineColor(0x000000));
$layer->setXData($labels);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000); # ->setFontAngle(-45);
# configure x-axis label format
$self->_configure_date_axis($c);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_hiv {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(600, 320);
my $patient = $self->stash->{request_data}->{patient_case}->{patient};
my $patient_name = sprintf '%s, %s',
uc $patient->{last_name}, # apply special rules to fname if config'd:
$self->format_first_name($patient) || ucfirst $patient->{first_name};
my $title = $c->addTitle($patient_name, "arialbi.ttf", 8);
$title->setMargin2(0, 0, 12, 12);
$c->setPlotArea(50, $title->getHeight(), $c->getWidth() - 100, $c->getHeight() -
$title->getHeight() - 70, 0xffffff, -1, $perlchartdir::Transparent,
$c->dashLineColor(0x888888, $perlchartdir::DotLine), -1);
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
$layer->addDataSet($data->{values}, 0x000000)->setDataSymbol(
$perlchartdir::DiamondSymbol, 7);
# add dashed red line for gaps ($perlchartdir::NoValue):
$layer->setGapColor($c->dashLineColor(0xff0000));
# Set the labels on the x axis.
$layer->setXData($data->{labels});
# get max value & set LinearScale:
{
my $vals = $data->{values}; # warn Dumper $vals;
my @nums = grep $_ ne $perlchartdir::NoValue, (@$vals, 1000); # warn Dumper \@nums;
# to return higher of (1000 or highest data value):
my $max_val = LIMS::Local::Utils::get_max_val(\@nums); # warn Dumper $max_val;
$c->yAxis()->setLinearScale(0, $max_val);
}
$c->yAxis()->setTitle('Absolute CD4 count (cells/uL)', "arialbd.ttf", 10);
# add shaded zone between 0 & 200:
$c->yAxis()->addZone(0, 200, 0xff9999);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000); # ->setFontAngle(-45);
# configure x-axis label format
$self->_configure_date_axis($c);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_pnh {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(600, 320);
my $request = $self->stash->{request_data};
# Set the plotarea at (55, 58) and of size 520 x 195 pixels, with white background.
# Turn on both horizontal and vertical grid lines with light grey color (0xcccccc)
$c->setPlotArea(55, 38, 520, 220, 0xffffff, -1, -1, 0xcccccc, 0xcccccc);
# Add a legend box at (50, 30) (top of the chart) with horizontal layout. Use 9 pts
# Arial Bold font. Set the background and border color to Transparent.
$c->addLegend(50, 0, 0, "arialbd.ttf", 9)
->setBackground($perlchartdir::Transparent);
=begin
# don't want title:
my $chart_title = $self->_get_chart_title($request); # warn $chart_title;
$c->addTitle($chart_title, "timesbi.ttf", 10); # ->setBackground(
0xffffff, 0x800000, perlchartdir::glassEffect());
=cut
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
# initialise data structure:
my %pnh_data = ( # content for clarity - not strictly required
granulocyte => undef,
erythrocyte => undef,
);
{ # sort $data->{values} AoA into %pnh_data hash:
my $values = $data->{values}; # warn Dumper $values;
for my $row (@$values) { # $row = arrayref:
push @{ $pnh_data{granulocyte} }, $row->[0];
push @{ $pnh_data{erythrocyte} }, $row->[1];
} # warn Dumper \%pnh_data;
}
$layer->addDataSet($pnh_data{granulocyte}, 0x0000ff, 'Granulocytes')->setDataSymbol(
$perlchartdir::SquareSymbol, 7);
$layer->addDataSet($pnh_data{erythrocyte}, 0xcf4040, 'Erythrocytes')->setDataSymbol(
$perlchartdir::CircleSymbol, 6);
$layer->setGapColor($c->dashLineColor(0x000080));
# Set the labels on the x axis.
$layer->setXData($data->{labels});
$c->yAxis()->setLinearScale(0, 100); # set range (min & max vals)
$c->yAxis()->setTitle('PNH clone (%)', "arialbd.ttf", 10);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000)->setFontAngle(-45);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_chimerism {
my ($self, $params) = @_; # params = arrayref of data params in required order
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(620, 340);
my $request = $self->stash->{request_data};
# Set the plotarea at (55, 58) and of size 520 x 195 pixels, with white background.
# Turn on both horizontal and vertical grid lines with light grey color (0xcccccc)
$c->setPlotArea(55, 48, 520, 220, 0xffffff, -1, -1, 0xcccccc, 0xcccccc);
# Add a legend box at (50, 30) (top of the chart) with horizontal layout. Use 9 pts
# Arial Bold font. Set the background and border color to Transparent.
$c->addLegend(50, 20, 0, "arialbd.ttf", 9)
->setBackground($perlchartdir::Transparent);
my $chart_title = $self->_get_chart_title($request); # warn $chart_title;
# Add a title to the chart using 15 points Arial Italic font. Set top/bottom margins
# to 12 pixels.
my $title = $c->addTitle($chart_title, "arialbi.ttf", 8);
$title->setMargin2(0, 0, 12, 12);
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
my %results = (); # initialise data structure for params
{ # sort $data->{values} AoA into %results hash:
my $values = $data->{values}; # warn Dumper $values;
for my $row (@$values) { # $row = arrayref:
my $i = 0; # param position counter for $row
for my $p (@$params) {
push @{ $results{$p} }, $self->_parse_data_val($row->[$i++]);
}
} # warn Dumper \%results;
}
$layer->addDataSet($results{cd3}, 0xff0000, 'CD3')->setDataSymbol(
$perlchartdir::SquareSymbol, 7);
$layer->addDataSet($results{cd4}, 0x006633, 'CD4')->setDataSymbol(
perlchartdir::StarShape(5), 10);
$layer->addDataSet($results{cd8}, 0x0000ff, 'CD8')->setDataSymbol(
$perlchartdir::CircleSymbol, 6);
$layer->addDataSet($results{cd15}, 0xff6600, 'CD15')->setDataSymbol(
$perlchartdir::TriangleShape, 7);
$layer->addDataSet($results{wbc}, 0x66ff00, 'Total')->setDataSymbol(
$perlchartdir::GlassSphere2Shape, 7);
# Set the labels on the x axis.
$layer->setXData($data->{labels}); # warn Dumper $data->{labels}
$c->yAxis()->setLinearScale(0, 120); # set range (min & max vals)
$c->yAxis()->setTitle('donor (%)', "arialbd.ttf", 10);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000); # ->setFontAngle(-45);
# these affect all 4 lines - see perldemo\missingpoints.pl for separate layers
$layer->setGapColor($c->dashLineColor(0x000080));
# configure x-axis label format
$self->_configure_date_axis($c);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_imatinib {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $width = 600; # default width
if ($self->stash->{small}) { # eg outreach plot
$width *= 0.6; # 360;
} # warn $width;
my $c = new XYChart($width, 320);
# set background colors (unless outreach plot):
unless ( $self->stash->{small} ) {
my $gradient = $c->linearGradientColor(
0, 0, 0, $c->getHeight() / 2, 0xe8f0f8, 0xaaccff
);
$c->setBackground($gradient, 0x88aaee);
}
$c->setRoundedFrame(); # $c->setDropShadow(); # doesn't look good on print
my $request = $self->stash->{request_data};
my $chart_title = $self->_get_chart_title($request); # warn $chart_title;
# Add a title to the chart using 15 points Arial Italic font. Set top/bottom margins
# to 12 pixels.
my $title = $c->addTitle($chart_title, "arialbi.ttf", 8);
$title->setMargin2(0, 0, 12, 12);
# Tentatively set the plotarea to 50 pixels from the left edge to allow for the
# y-axis, and to just under the title. Set the width to 65 pixels less than the chart
# width, and the height to reserve 90 pixels at the bottom for the x-axis and the
# legend box. Use pale blue (e8f0f8) background, transparent border, and grey
# (888888) dotted horizontal and vertical grid lines.
$c->setPlotArea(50, $title->getHeight(), $c->getWidth() - 65, $c->getHeight() -
$title->getHeight() - 70, 0xffffff, -1, $perlchartdir::Transparent,
$c->dashLineColor(0x888888, $perlchartdir::DotLine), -1);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000); # ->setFontAngle(-45);
$c->yAxis()->setTitle("BCR-ABL:ABL Ratio (%)", "arialbd.ttf", 10);
$c->yAxis()->setLabelStyle("arialbd.ttf");
$c->yAxis()->setLogScale(.0001, 1000);
# Add a green (0x008000) mark at y = 40 using a line width of 2.
$c->yAxis()->addMark(0.055, 0x000000, 'MMR')->setLineWidth(1);
$c->yAxis()->addMark(55, 0x000000, '55%')->setLineWidth(1);
my $layer;
if ( 1 ) { # add coloured zones:
$c->yAxis()->addZone(0, 0.055, 0x99ff99);
$c->yAxis()->addZone(0.055, 55, 0xffff99);
$c->yAxis()->addZone(55, 1000, 0xff9999);
$layer = $c->addLineLayer();
=begin # if adding normal data points (instead of pointType):
$layer->addDataSet(
$data->{values},
0x000080,
'Data'
)->setDataSymbol($perlchartdir::DiamondSymbol, 10);
# fill in missing data (doesn't work with yZoneColor):
$layer->setGapColor($c->dashLineColor(0x000080));
=cut
}
else { # add coloured zones (different style):
my $lineColors = $c->yZoneColor(.055, 0x99ff99,0xffff99);
$lineColors = $c->yZoneColor(55, $lineColors, 0xff9999);
$layer = $c->addAreaLayer($data->{values}, $lineColors);
}
# We select the points with pointType = 0 (the non-selected points will be set to
# NoValue), and use yellow (ffff00) 15 pixels high 5 pointed star shape symbols for
# the points. (This example uses both x and y coordinates. For charts that have no x
# explicitly coordinates, use an empty array as dataX.)
$c->addScatterLayer(
$data->{labels},
new ArrayMath($data->{values})->selectEQZ(
$data->{points}, $perlchartdir::NoValue
)->result(), "MRD -ve",
perlchartdir::StarShape(5), 12, 0xffff00);
# Similar to above, we select the points with pointType - 1 = 0 and use green (ff00)
# 13 pixels high six-sided polygon as symbols.
$c->addScatterLayer(
$data->{labels},
new ArrayMath($data->{values})->selectEQZ(
new ArrayMath($data->{points})->sub(1)->result(), $perlchartdir::NoValue
)->result(), "MRD +ve",
$perlchartdir::DiamondSymbol, 10);
# Finally, add a blue (0000ff) line layer with line width of 2 pixels
$layer = $c->addLineLayer($data->{values}, 0x000080);
# $layer->setLineWidth(2);
$layer->setXData($data->{labels});
# Add a legend box where the bottom-center is anchored to the 12 pixels above the
# bottom-center of the chart. Use horizontal layout and 8 points Arial font.
my $legendBox = $c->addLegend(
$c->getWidth() / 2,
$c->getHeight() - 12, 0,
"arial.ttf", 8
);
$legendBox->setAlignment($perlchartdir::BottomCenter);
# Set the legend box background and border to pale blue (e8f0f8) and bluish grey (445566)
if ( $self->stash->{small} ) {
$legendBox->setBackground(0xffffff, 0xffffff);
}
else {
$legendBox->setBackground(0xe8f0f8, 0x445566);
# Use rounded corners of 5 pixel radius for the legend box
$legendBox->setRoundedCorners(5);
}
# Use rounded corners of 5 pixel radius for the legend box
$legendBox->setRoundedCorners(5);
# configure x-axis label format
$self->_configure_date_axis($c);
# Adjust the plot area size, such that the bounding box (inclusive of axes) is 10
# pixels from the left edge, just below the title, 25 pixels from the right edge, and
# 8 pixels above the legend box.
$c->packPlotArea(10, $title->getHeight(), $c->getWidth() - 25,
$c->layoutLegend()->getTopY() - 8);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_specimen_turnround {
my ($self, $stats) = @_; # warn Dumper $stats;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $n_labels = scalar @{ $data->{labels} }; # warn $n_labels;
# Create a XYChart object of size 400 x 240 pixels.
my $c = new XYChart(600, 280);
# Set the plotarea at (30, 20) and of size 200 x 200 pixels
$c->setPlotArea(60, 30, 500, 200); # warn $c->getPlotArea()->getWidth();
# Add a bar chart layer using the given data
my $layer = $c->addBarLayer($data->{values});
# very thin bars loose colour, so remove borders:
$layer->setBorderColor(-1, 0) if $n_labels > 50;
# Set the labels on the x axis.
$c->xAxis()->setLabels($data->{labels});
# reduce number of labels if excessive - see:
# http://www.chartdir.com/forum/download_thread.php?bn=chartdir_support&pattern=&thread=1310083923):
$c->xAxis()->setLabelStep( $n_labels * 50 / $c->getPlotArea()->getWidth() );
$c->xAxis()->setTitle('Days', 'arialbd.ttf', 10);
# Add a vertical marker line on x axis:
my $marker = $stats->{marker}; # 95 percentile
my $xMark1 = $c->xAxis()->addMark($marker, 0x0000ff);
# Set the mark line width to 2 pixels
$xMark1->setLineWidth(2);
# Put the mark label at the left of the mark line
$xMark1->setAlignment($perlchartdir::Left);
# Rotate the mark label by 90 degrees so it draws vertically
$xMark1->setFontAngle(90);
return $c;
}
# ------------------------------------------------------------------------------
sub log_y {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
# Create a XYChart object of size 400 x 240 pixels.
my $c = new XYChart(600, 300);
# Set the plotarea at (30, 20) and of size 200 x 200 pixels
$c->setPlotArea(30, 20, 600, 200);
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
$layer->addDataSet($data->{values}, 0xcf4040)->setDataSymbol(
$perlchartdir::DiamondSymbol, 7);
$layer->setGapColor($c->dashLineColor(0x00ff00));
#$c->setDateCol(0, perlchartdir::chartTime(2002, 9, 4), 86400, 1);
# Set the labels on the x axis.
$c->xAxis()->setLabels($data->{labels});
# set y-axis to log scale:
$c->yAxis()->setLogScale3();
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000)->setFontAngle(-45);
return $c;
}
# ------------------------------------------------------------------------------
sub donut_chart {
my $self = shift;
my $data = $self->_get_chart_data();
# Create a PieChart object of size 600 x 320 pixels. Set background color to brushed
# silver, with a 2 pixel 3D border. Use rounded corners of 20 pixels radius.
my $c = new PieChart(900, 300);
# Set donut center at (160, 175), and outer/inner radii as 110/55 pixels
$c->setDonutSize(450, 150, 110, 55);
# Set the pie data and the pie labels
$c->setData($data->{values}, $data->{labels});
# Use ring shading effect for the sectors
$c->setSectorStyle($perlchartdir::RingShading);
# Use the side label layout method
$c->setLabelLayout($perlchartdir::SideLayout);
# Set the label box background color the same as the sector color, with glass effect,
# and with 5 pixels rounded corners
my $t = $c->setLabelStyle(
'arial.ttf', 9, $perlchartdir::SameAsMainColor
);
$t->setBackground(
0xf5f5f5,
#$perlchartdir::SameAsMainColor,
# $perlchartdir::Transparent,
#perlchartdir::glassEffect()
);
# $t->setRoundedCorners(5);
# Set the border color of the sector the same color as the fill color. Set the line
# color of the join line to black (0x0)
#$c->setLineColor($perlchartdir::SameAsMainColor, 0x000000);
return $c;
}
# ------------------------------------------------------------------------------
sub inverted_xy {
my $self = shift;
my $data = $self->_get_chart_data();
# need to reverse both data sets so largest numbers display at top:
my @values = @{ $data->{values} };
@values = reverse @values;
my @labels = @{ $data->{labels} };
@labels = reverse @labels;
# Create a XYChart object of size 600 x 250 pixels
my $c = new XYChart(700, 400);
# Set the plotarea at (45, 40) and of 300 x 160 pixels in size. Use alternating light
# grey (f8f8f8) / white (ffffff) background.
$c->setPlotArea(255, 40, 480, 300, 0xf8f8f8, 0xffffff);
# Add a multi-color bar chart layer
my $layer = $c->addBarLayer3(\@values);
# Enable bar label for the whole bar
$layer->setAggregateLabelStyle();
# Swap the x and y axes to create a horizontal bar chart
$c->swapXY();
# Set bar shape to circular (cylinder)
$layer->setBarShape($perlchartdir::CircleShape);
# Set the labels on the x axis.
$c->xAxis()->setLabels(\@labels);
# Reverse 10% space at the right during auto-scaling to allow space for the aggregate
# bar labels
$c->yAxis()->setAutoScale(0.15);
# Add a title to the y axis with 16pts Arial Bold font
if ( my $label = $self->stash->{y_axis_label} ) {
$c->yAxis()->setTitle($label, 'arialbd.ttf', 12);
}
return $c;
}
# ------------------------------------------------------------------------------
sub user_workload_stats {
my $self = shift;
my $data = $self->_get_chart_data();
# need to reverse both data sets so largest numbers display at top:
my @values = @{ $data->{values} };
my @labels = @{ $data->{labels} };
# Create a XYChart object of size 600 x 250 pixels
my $c = new XYChart(500, 350);
# Set the plotarea at (45, 40) and of 300 x 160 pixels in size. Use alternating light
# grey (f8f8f8) / white (ffffff) background.
$c->setPlotArea(80, 40, 400, 250, 0xf8f8f8, 0xffffff);
# Add a multi-color bar chart layer
my $layer = $c->addBarLayer3(\@values);
# Enable bar label for the whole bar
$layer->setAggregateLabelStyle();
# Swap the x and y axes to create a horizontal bar chart
$c->swapXY();
# Set bar shape to circular (cylinder)
$layer->setBarShape($perlchartdir::CircleShape);
# Set the labels on the x axis.
$c->xAxis()->setLabels(\@labels);
# Reverse 10% space at the right during auto-scaling to allow space for the aggregate
# bar labels
$c->yAxis()->setAutoScale(0.15);
# Add a title to the y axis with 16pts Arial Bold font
if ( my $label = $self->stash->{y_axis_label} ) {
$c->yAxis()->setTitle($label, 'arialbd.ttf', 12);
}
return $c;
}
# ------------------------------------------------------------------------------
sub plot_trend_analysis {
my $self = shift;
my $data = $self->stash->{chart_data}; # warn Dumper $data;
# chart data (reverse order for all values):
my @freqs = reverse @{ $data->{value} };
my @totals = reverse @{ $data->{totals} };
# make labels (exept zero) negative (0, -3, -6, etc), needs escaped '-':
my @labels = map { $_ ? '\-'.$_ : $_ } reverse @{ $data->{interval} }; # warn Dumper \@labels;
my $mean = LIMS::Local::Utils::mean_value(@freqs);
my $yAxis1_color = 0xc00000; # red
# my $yAxis2_color = 0x008000; # green
# my $area_color = 0x8033ff33; # lime
my $yAxis2_color = 0x000080; # blue
my $area_color = 0x6699bb; # blue
my $c = new XYChart(650, 350);
# Set the plot area:
$c->setPlotArea(60, 40, 520, 250);
# Add a title to the chart using 8pt Arial Bold font
$c->addTitle($self->stash->{title}, "arialbd.ttf", 10);
# Set the labels on the x axis.
$c->xAxis()->setLabels(\@labels);
$c->xAxis()->setTitle("3-month intervals");
# primary y axis - frequency data ==============================================
my $layer1 = $c->addLineLayer();
$layer1->addDataSet(\@freqs, $yAxis1_color)->setDataSymbol(
$perlchartdir::CircleSymbol, 7);
$layer1->setLineWidth(1);
# Add a title to the primary (left) y axis
$c->yAxis()->setTitle($self->stash->{yAxis1});
# Set the axis, label and title colors for the primary y axis:
$c->yAxis()->setColors($yAxis1_color, $yAxis1_color, $yAxis1_color);
# Add a horizontal red (0x800080) mark line at y = 80
#my $yMark = $c->yAxis()->addMark($mean, 0xff0000); # title interfers with chart
my $yMark = $c->yAxis()->addMark($mean,
$c->dashLineColor($yAxis1_color, $perlchartdir::DashLine));
# Put the mark label at the top center of the mark line
$yMark->setAlignment($perlchartdir::TopLeft); # not using title
# secondary y axis - totals data ===============================================
# my $layer2 = $c->addLineLayer(); # using coloured area:
# $layer2->addDataSet($totals, 0x00c000)->setDataSymbol(
# $perlchartdir::DiamondSymbol, 7);
# $layer2->setLineWidth(2);
#my $layer2 = $c->addAreaLayer(\@totals, $area_color);
# $c->yZoneColor(60, 0x8033ff33, 0x80ff3333));
#$layer2->setLineWidth(0); # no line on top of area
my $layer2 = $c->addBarLayer(\@totals, $area_color);
# $layer2->setBorderColor($perlchartdir::Transparent);
$layer2->setBorderColor($perlchartdir::Transparent,
perlchartdir::barLighting(0.8, 1.3));
$layer2->setRoundedCorners(); # requires ChartDirector v6+
$layer2->setUseYAxis2();
# Add a title to the secondary (right) y axis
$c->yAxis2()->setTitle($self->stash->{yAxis2});
# set the axis, label and title colors for the secondary y axis:
$c->yAxis2()->setColors($yAxis2_color, $yAxis2_color, $yAxis2_color);
$c->yAxis2()->setLinearScale(0, $perlchartdir::NoValue);
return $c;
}
# ------------------------------------------------------------------------------
sub _get_chart_data {
my $self = shift;
my $chart_data = $self->stash->{chart_data}; # warn Dumper $chart_data;
my %data = ();
for my $row (@$chart_data) { # warn Dumper $row;
push @{ $data{values} }, $row->[0]; # data points
push @{ $data{labels} }, $row->[1]; # labels
push @{ $data{points} }, $row->[2] if defined $row->[2]; # point types (optional); maybe '0'
}
return \%data;
}
# ------------------------------------------------------------------------------
sub _get_chart_title {
my ($self, $request) = @_;
my $patient = $request->{patient_case}->{patient};
if ( $self->query->param('ANONYMISE_CHART') ) {
return join ', ',
uc( substr $patient->{first_name}, 0, 1 ),
uc( substr $patient->{last_name}, 0, 1 ); # 1st chars
}
my $title = sprintf '%s, %s [%s]',
uc $patient->{last_name},
ucfirst $patient->{first_name},
$patient->{nhs_number};
return $title;
}
# ------------------------------------------------------------------------------
# returns value of data point if defined (ie incl. zero), or $perlchartdir::NoValue
sub _parse_data_val {
my ($self, $val) = @_;
return defined $val
? $val # incl. zero
: $perlchartdir::NoValue; # so setGapColor works
}
# ------------------------------------------------------------------------------
sub _configure_date_axis {
my ($self, $c) = @_;
#
# In this demo, the time range can be from a few years to a few days. We
# demonstrate how to set up different date/time format based on the time range.
#
my $day = 86400; # seconds
# If all ticks are yearly aligned, then we use "yyyy" as the label format.
$c->xAxis()->setFormatCondition("align", 360 * $day);
$c->xAxis()->setLabelFormat("{value|yyyy}");
# If all ticks are monthly aligned, then we use "mmm yyyy" in bold font as
# the first label of a year, and "mmm" for other labels.
$c->xAxis()->setFormatCondition("align", 30 * $day);
$c->xAxis()->setMultiFormat(perlchartdir::StartOfYearFilter(),
"<*font=bold*>{value|mmm<*br*>yyyy}",
perlchartdir::AllPassFilter(), "{value|mmm}");
# If all ticks are daily algined, then we use "mmm dd<*br*>yyyy" in bold
# font as the first label of a year, and "mmm dd" in bold font as the first
# label of a month, and "dd" for other labels.
$c->xAxis()->setFormatCondition("align", $day);
$c->xAxis()->setMultiFormat(perlchartdir::StartOfYearFilter(),
"<*block,halign=left*><*font=bold*>{value|dd mmm<*br*>yyyy}",
perlchartdir::StartOfMonthFilter(), "<*font=bold*>{value|dd mmm}");
$c->xAxis()->setMultiFormat2(perlchartdir::AllPassFilter(), "{value|dd}");
# For all other cases (sub-daily ticks), use "hh:nn<*br*>mmm dd" for the
# first label of a day, and "hh:nn" for other labels.
$c->xAxis()->setFormatCondition("else");
$c->xAxis()->setMultiFormat(perlchartdir::StartOfDayFilter(),
"<*font=bold*>{value|hh:nn dd mmm}", perlchartdir::AllPassFilter(),
"{value|hh:nn}");
}
1;
