package LIMS::Controller::Roles::Chart;
use Moose::Role;
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 ) {
#============================================================
# Draw a pie chart where the label is on top of the pie
#============================================================
# 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 {
#============================================================
# Draw a pie chart where the label is outside the pie
#============================================================
# 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 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(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);
# Set the labels on the x axis.
$c->xAxis()->setLabels($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 plot_outreach {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(720, 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, 640, 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 $patient = sprintf '%s, %s [%s]',
uc $request->{patient_case}->{patient}->{last_name},
ucfirst $request->{patient_case}->{patient}->{first_name},
$request->{patient_case}->{patient}->{nhs_number};
$c->addTitle($patient, "timesbi.ttf", 10); # ->setBackground(
0xffffff, 0x800000, perlchartdir::glassEffect());
=cut
# initialise data structure:
my %data = ( # content for clarity - not strictly required
hb => undef,
plts => undef,
creatinine => undef,
total_b_cells => undef, # should be 'abnormal B cells'
);
{ # sort $data->{values} AoA into %data hash:
my $values = $data->{values}; # warn Dumper $values;
for my $row (@$values) { # $row = arrayref:
push @{ $data{hb} }, $row->[0] || $perlchartdir::NoValue;
push @{ $data{plts} }, $row->[1] || $perlchartdir::NoValue;
push @{ $data{creatinine} }, $row->[2] || $perlchartdir::NoValue;
push @{ $data{total_b_cells} }, $row->[3] || $perlchartdir::NoValue;
} # warn Dumper \%data;
}
# Add a line chart layer using the given data
my $layer = $c->addLineLayer();
$layer->addDataSet($data{hb}, 0x006633, 'Hb')->setDataSymbol(
$perlchartdir::SquareSymbol, 7);
$layer->addDataSet($data{plts}, 0xcf4040, 'Plts')->setDataSymbol(
$perlchartdir::DiamondSymbol, 9);
$layer->addDataSet($data{creatinine}, 0x0000ff, 'Creatinine')->setDataSymbol(
$perlchartdir::CircleSymbol, 6);
$layer->addDataSet($data{total_b_cells}, 0xff6600, 'Total B cells')->setDataSymbol(
$perlchartdir::GlassSphere2Shape, 7);
# these affect all 4 lines - see perldemo\missingpoints.pl for separate layers
$layer->setGapColor($c->dashLineColor(0x000000));
$layer->setLineWidth(2);
# Set the labels on the x axis.
$layer->setXData($data->{labels});
$c->yAxis()->setLogScale(1, 1000); # set range (min & max vals)
# $c->yAxis()->setTitle('Foo (%)', "arialbd.ttf", 10);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000)->setFontAngle(-45);
return $c;
}
# ------------------------------------------------------------------------------
sub plot_hiv {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(600, 320);
my $request = $self->stash->{request_data};
my $patient = sprintf '%s, %s',
uc $request->{patient_case}->{patient}->{last_name},
ucfirst $request->{patient_case}->{patient}->{first_name};
my $title = $c->addTitle($patient, "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}, 0xcf4040)->setDataSymbol(
$perlchartdir::DiamondSymbol, 7);
# Set the labels on the x axis.
$layer->setXData($data->{labels});
# get max value & set LinearScale:
{
my $vals = $data->{values};
my $max_value = 2000; # minimum value
for (@$vals) { # warn $_;
next unless $_ > $max_value;
$max_value = $_;
} # warn $max_value;
$c->yAxis()->setLinearScale(0, $max_value);
}
$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);
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 $patient = sprintf '%s, %s [%s]',
uc $request->{patient_case}->{patient}->{last_name},
ucfirst $request->{patient_case}->{patient}->{first_name},
$request->{patient_case}->{patient}->{nhs_number};
$c->addTitle($patient, "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_imatinib {
my $self = shift;
my $data = $self->_get_chart_data(); # warn Dumper $data;
my $c = new XYChart(600, 320);
# set background colors:
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 $patient = sprintf '%s, %s [%s]',
uc $request->{patient_case}->{patient}->{last_name},
ucfirst $request->{patient_case}->{patient}->{first_name},
$request->{patient_case}->{patient}->{nhs_number};
# Add a title to the chart using 15 points Arial Italic font. Set top/bottom margins
# to 12 pixels.
my $title = $c->addTitle($patient, "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->yAxis()->setTitle("BCR-ABL:ABL Ratio (%)", "arialbd.ttf", 10);
$c->xAxis()->setLabelStyle("arial.ttf", 10, 0x000000)->setFontAngle(-45);
$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(), "MDR -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)
$legendBox->setBackground(0xe8f0f8, 0x445566);
# Use rounded corners of 5 pixel radius for the legend box
$legendBox->setRoundedCorners(5);
# 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 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 _get_chart_data {
my $self = shift;
my $chart_data = $self->stash->{chart_data}; # warn Dumper $chart_data;
my %data = ();
for my $row (@$chart_data) {
push @{ $data{values} }, $row->[0]; # data points
push @{ $data{labels} }, $row->[1]; # labels
push @{ $data{points} }, $row->[2] if $row->[2]; # point types (optional)
}
return \%data;
}
1;
