• Files
• Commits
• Log
• Graph
• Stats

use Modern::Perl;

use lib (
	'/home/raj/perl-lib',
	'/home/raj/perl-lib/ChartDirector/lib',
);

use Data::Printer ( alias => 'p', use_prototypes => 0 );
use SQL::Abstract::More;
use FindBin qw($Bin);
use Local::Utils;
use Local::DB;
use DateTime;

use perlchartdir;
use autodie;

#===============================================================================
my $interval = 3; # months
#===============================================================================

$Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir

my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
my $sqla = SQL::Abstract::More->new;

my $today = Local::Utils::today();

my @tbl_rels = (
        'requests|r' 				   ,   'r.id = tr.request_id'       ,
        'request_lab_test_results|tr'  ,   'tr.lab_test_id = lt.id'     ,
        'lab_tests|lt'                 ,   'ls.id = lt.lab_section_id'  ,
        'lab_sections|ls'              ,   'r.id = rrd.request_id'      ,
        'request_report_detail|rrd'    ,   'rrd.diagnosis_id = d.id'    ,
        'diagnoses|d'
);

my %tests = (
	myc_dlbcl => { # myc in DLBCL
		restriction => {
			'd.icdo3' => '9680/3',
			'lt.test_name' => 'cmyc',
            'ls.section_name' => 'FISH',
		},
		title => {
			chart   => 'MYC/DLBCL',
			yAxis1  => 'MYC rearrangement frequency',
			yAxis2  => 'total MYC requests',
			imgName => 'myc_dlbcl',
		},
		gene_status => 'rearranged',
	},
	tp53_cll => {
		restriction => {
			'd.icdo3' => '9823/3',
			'd.name'  => { rlike => 'cll', not_rlike => 'B-cell lymphocytosis' }, # check which cll's required
			'lt.test_name' => 'p53',
            'ls.section_name' => 'FISH',
		}, # icdo3 = '9823/3' and name rlike 'cll' and name not rlike 'Monoclonal B-cell lymphocytosis'
		title => {
			chart   => 'TP53/CLL',
			yAxis1  => 'TP53 deletion frequency',
			yAxis2  => 'total TP53 requests',
			imgName => 'p53_cll',
		},
		gene_status => 'deletion',	
	},
	fgfr3_igh_myeloma => {
		restriction => {
			'd.icdo3' => '9732/3',
			'lt.test_name' => 'fgfr3_igh',
            'ls.section_name' => 'FISH',
		},
		title => {
			chart   => 'FGFR3-IGH/myeloma',
			yAxis1  => 'FGFR3-IGH translocation frequency',
			yAxis2  => 'total FGFR3-IGH requests',
			imgName => 'fgfr3_igh_myeloma',
		},
		gene_status => 'translocation',	
	},	
);

while ( my ($test, $data) = each %tests ) {
	my %h;
	# hashref of restrictions for where clause (eg icdo3 => '9830/3):
	my $restriction = $data->{restriction};
	# test result for monitoring (eg rearranged, deleted, etc):
	my $gene_status = $data->{gene_status};
	
	for my $i (0 .. 24) { # intervals
		next if $i % $interval; # p $i; # every 3 months
		my ($sql, @bind) = _generate_query($restriction, $i);
		my $results = $dbix->query($sql, @bind)->map; # p $results;
		
		my $result = $results->{$gene_status}; # p $result;
		my $total  = Local::Utils::math_sum(values %$results); # p $total;
		my $value  = $result / $total; # p [$i, $value];
		
		push @{ $h{interval} }, $i; 
		push @{ $h{value}    }, $value;
		push @{ $h{totals}   }, $total;
	} # p \%h;

	my $chart = make_chart(\%h, $data->{title});
}

sub make_chart {
    my ($data, $title) = @_;
	
	# chart data (reverse order for all values):
	my @freqs  = reverse @{ $data->{value} };
	my @totals = reverse @{ $data->{totals} };
	# make labels negative (needs escaped '-'), exept zero (0, -3, -6, etc):
	my @labels = map { $_ ? '\-'.$_ : $_ } reverse @{ $data->{interval} }; # p \@labels;

	# Create a XYChart object of size 300 x 180 pixels
	my $c = new XYChart(650, 350);

	# Set the plot area at (50, 20) and of size 200 x 130 pixels
	$c->setPlotArea(60, 40, 520, 250);

	# Add a title to the chart using 8pt Arial Bold font
	$c->addTitle($title->{chart}, "arialbd.ttf", 10);

	my $totals_color = 0x008000; # green
	my $freqs_color  = 0xc00000; # red
	my $area_color   = 0x8033ff33; # lime
	
	# Set the labels on the x axis.
	$c->xAxis()->setLabels(\@labels);
	$c->xAxis()->setTitle("$interval-month intervals");

	# Add a title to the primary (left) y axis
	$c->yAxis()->setTitle($title->{yAxis1});

	# Set the axis, label and title colors for the primary y axis:
	$c->yAxis()->setColors($freqs_color, $freqs_color, $freqs_color);

	# primary y axis - frequency data:
    my $layer1 = $c->addLineLayer();
    $layer1->addDataSet(\@freqs, $freqs_color)->setDataSymbol(
        $perlchartdir::CircleSymbol, 7);
    $layer1->setLineWidth(1);

	# Add a title to the secondary (right) y axis
	$c->yAxis2()->setTitle($title->{yAxis2});
	# set the axis, label and title colors for the secondary y axis:
	$c->yAxis2()->setColors($totals_color, $totals_color, $totals_color);
	$c->yAxis2()->setLinearScale(0, $perlchartdir::NoValue);
    # totals data for secondary y axis:
	# 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
    $layer2->setUseYAxis2();

	# Output the chart
	my $filename = sprintf '%s/%s.png', $Bin, $title->{imgName};
	$c->makeChart($filename);
}

sub _generate_query {
	my ($restriction, $n) = @_; # warn $t0;
	
	my $t1 = $today->clone->subtract(months => $n + 3)->ymd;
	my $t2 = $today->clone->subtract(months => $n)->ymd;	
	$restriction->{'date(tr.time)'} = { -between => [ $t1, $t2 ] };
	
	my ($sql, @bind) = $sqla->select(
		-columns => [ 'tr.result', 'count(*)' ],
		-from    => [ -join => @tbl_rels ],
		-where   => $restriction,
		-group_by => 'tr.result',
	); # p $sql; p \@bind;
	return ($sql, @bind);
}