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, paraprotein => undef, abnormal_b_cells => undef, ); { # 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{paraprotein} }, $row->[3] || $perlchartdir::NoValue; push @{ $data{abnormal_b_cells} }, $row->[4] || $perlchartdir::NoValue; } # warn Dumper \%data; } # Add a line chart layer using the given data my $layer = $c->addLineLayer(); $layer->addDataSet($data{hb}, 0xff0000, 'Hb')->setDataSymbol( $perlchartdir::SquareSymbol, 7); $layer->addDataSet($data{plts}, 0x006633, 'Plts')->setDataSymbol( perlchartdir::StarShape(5), 10); $layer->addDataSet($data{creatinine}, 0x0000ff, 'Creatinine')->setDataSymbol( $perlchartdir::CircleSymbol, 6); $layer->addDataSet($data{paraprotein}, 0xff6600, 'Paraprotein')->setDataSymbol( $perlchartdir::TriangleShape, 7); $layer->addDataSet($data{abnormal_b_cells}, 0x66ff00, 'Abnormal 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_outreach_param { my $self = shift; my $data = $self->_get_chart_data(); # warn Dumper $data; # extract labels & vals, set any nulls to $perlchartdir::NoValue: my $labels = $data->{labels}; my $values = $data->{values}; map { $_ ||= $perlchartdir::NoValue } @$values; my $c = new XYChart(280, 250); $c->setPlotArea(31, 21, 210, 170, 0xffffc8); my $layer = $c->addLineLayer(); $layer->addDataSet($values, 0x0000ff)->setDataSymbol( $perlchartdir::CircleSymbol, 4); { # how many dp's to take data vals: no warnings 'uninitialized'; my $dps = 0; # default VAL: for (@$values) { # warn $_; next VAL if ! $_ || $_ eq $perlchartdir::NoValue; # skip empty/null my ($decimals) = $_ =~ /\d+\.(\d+)/; # warn $decimals; $dps = length($decimals) if length($decimals) > $dps; # warn $dps; } # warn Dumper $dps; $layer->setDataLabelFormat("{value|$dps}");# value to how many dp's } $layer->setGapColor($c->dashLineColor(0x000000)); $layer->setXData($labels); $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;