package LIMS::Controller::Audit;

use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
	'LIMS::Controller::Roles::Misc',
    'LIMS::Controller::Roles::SessionStore',
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Data::Dumper;
use Statistics::Descriptive;

# ------------------------------------------------------------------------------
# default() should never be called direct - redirect to start page:
sub default : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    return $self->redirect( $self->query->url );
}

# ------------------------------------------------------------------------------
sub turnaround : Runmode { # calculates as average and 95th-percentile
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    my $selection   = $self->param('id'); # eg specimen_type, location, etc
	my $calc_method = $self->param('Id'); # average, 95th-percentile

    my $vars = $self->query->Vars();
    $vars->{selection} = $selection; # warn Dumper $vars;
    
	my ($data, $title, $parsed, $tt);
	if ( $calc_method eq 'average' ) {
		($data, $title)
			= $self->model('Audit')->turnaround_times_average($vars);
		# sort data by requested field (defaults to specimen type):
		$parsed = $self->_sort_turnaround_data_average($data); # AoH (sorted)
		$tt = 'audit/turnaround_average.tt';
	}
	elsif ( $calc_method eq 'percentile' ) {
		($data, $title)
			= $self->model('Audit')->turnaround_times_percentile($vars);
		$parsed = $self->_calc_turnaround_data_percentile($data);
		$tt = 'audit/turnaround_percentile.tt';
	}
    
    $self->tt_params(
        data  => $parsed,
        title => $title,
        start_date => $self->model('Request')->get_first_request_date(),
    );    
    return $self->tt_process($tt);
}

# ------------------------------------------------------------------------------
sub turnaround_chart : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
    my $specimen = $self->param('id');

    my $vars = $self->query->Vars();
    $vars->{specimen} = $specimen; # warn Dumper $vars;

	my ($data, $title) = $self->model('Audit')->turnaround_times_chart($vars); # warn Dumper $data;
        # warn Dumper [ LIMS::Local::Utils::n_sort($data) ]; # to dump for manual calculation
	my $stat = Statistics::Descriptive::Full->new();
	$stat->add_data(@$data);
	
    my %s = ( chart_title => $title );	# for session
    
	{ # generate frequency data & add to session for chart:
        my $unique = LIMS::Local::Utils::get_unique_elements($data); # warn Dumper $unique;
		my @monotonic = LIMS::Local::Utils::n_sort($unique); # warn Dumper \@monotonic;
		my %f = $stat->frequency_distribution(\@monotonic); # warn Dumper \%f;
        
        # require every x-axis val from 0 to max to get 95th percentile line consistent:
        my $max_val = LIMS::Local::Utils::get_max_val(\@monotonic);
        $f{$_} ||= 0 for ( 0 .. $max_val ); # so chart doesn't skip empties
        $s{chart_data} = \%f;
	}
	
	# callback for .tt (call in scalar context to get value only):
	my $x_percentile = sub { my $x = $stat->percentile(@_); $x };
	$self->tt_params( x_percentile => $x_percentile );

	my $ninety_five  = $stat->percentile(95); # call in scalar context
	
	my %stats = (
		count 	  => $stat->count(),
		mean 	  => $stat->mean(),
		sum   	  => $stat->sum(),
		median 	  => $stat->median(),
		mode 	  => $stat->mode(),
		range 	  => $stat->sample_range(),
		marker    => $ninety_five,
		std_dev   => $stat->standard_deviation(),
		variance  => $stat->variance(),
	);
    $s{chart_stats} = \%stats;
    # add all _turnaround_chart_* to session:
	$self->session->param( _turnaround_chart => \%s );
	
	$self->tt_params(
        start_date => $self->model('Request')->get_first_request_date(),
        stats      => \%stats,
    );
	return $self->tt_process();
}

# ------------------------------------------------------------------------------
sub nhs_number : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $vars = $self->query->Vars();

    my ($data, $title) = $self->model('Audit')->nhs_number_supplied($vars);
    
    $self->tt_params(
        data  => $data,
        title => $title,
        start_date => $self->model('Request')->get_first_request_date(),
    );    
    return $self->tt_process();
}

# ------------------------------------------------------------------------------
sub revised_diagnoses : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $vars = $self->query->Vars(); # warn Dumper $vars;
    $vars->{sort_by} ||= 'date'; # temp. until constraints can pass env vars
    
    my ($data, $title) = $self->model('Audit')->revised_diagnoses($vars);
    
    my $total_reported = $data->{total_reported}; # count
    my $user_reported  = $data->{user_report_counts}; # if sort_by ne 'date'
    my $user_details   = $data->{user_details}; # if sort_by ne 'date'
    
    my $revisions = $data->{revisions}; # arrayref; maybe manipulated below, so:

    my $request_ids = $data->{request_ids}; # arrayref
    my $rev_count   = scalar @$request_ids; # revisions count
    
    # get specimens map:
	my $specimen_map = $self->specimen_map($request_ids);
    
    $self->tt_params(
        total_count   => $total_reported,
        specimen_map  => $specimen_map,
        user_details  => $user_details,
        user_counts   => $user_reported,
        rev_count     => $rev_count,
        revisions     => $revisions,
        title         => $title,
        sort_by       => $vars->{sort_by},
        start_date    => $self->model('Request')->get_first_request_date(),
    );    
    return $self->tt_process();    
}

# ------------------------------------------------------------------------------
sub user_workload : Runmode {
    my $self = shift;
    
    my $vars = $self->query->Vars(); # warn Dumper $vars;

    my @actions = qw( screened reported authorised );

    my %args = ( action => \@actions, vars => $vars );
    my $data = $self->model('Audit')->user_workload(\%args); # warn Dumper $data;

	my $stats = $data->{stats}; # AoH
    $self->stash( duration => $data->{title}, vars => $vars ); # for .tt

    my %h1 = (); # for chart
    my %h2 = (); # for table cols
    my %h3 = (); # for individual result breakdown

    for my $entry (@$stats) { # warn Dumper $entry;
        my $request_specimen = $entry->{specimen};
        my $specimen_type = $self->_get_specimen_type($request_specimen);
           # warn Dumper [$request_specimen, $specimen_type];
        
        my $action = $entry->{action};
        my $user   = $entry->{username};
        
        $h1{$action}{$user}++;
        $h2{$action}{$user}{$specimen_type}++;  
        $h3{$action}{$user}{$specimen_type}{$request_specimen}++;  
    } # warn Dumper [\%h1, \%h2, \%h3];

    # freeze stats data in session for chart (to save 3 more db queries):
    $self->session_store_hashref(\%h1, '_user_workload_data');
    
	$self->tt_params(
		data   => \%h2,
		detail => \%h3,
		sum    => sub { LIMS::Local::Utils::sum_list(@_) }, # callback to calculate totals
	);
    $self->tt_process();
}

# ------------------------------------------------------------------------------
sub _get_specimen_type {
    my ($self, $sample_code) = @_; # warn $sample_code if $sample_code =~ '-';
    
    # only interested in BMAT, BMA, PB or Tissue biopsy:    
    return $sample_code if grep $sample_code eq $_, qw(BMAT BMA PB); # single specimens
    
    return 'Tissue' if $sample_code =~ /\A[DGLRTX](A|[BS][LP]|F|U)/;
    
    # for multi-specimen requests:
    return 'BMAT' if $sample_code =~ /BMAT/;
    return 'BMA'  if $sample_code =~ /BMA/;
    return 'PB'   if $sample_code =~ /PB/;
    
    return 'Other'; # everything else, including multi-specimen request not matched
}

# ------------------------------------------------------------------------------
sub _calc_turnaround_data_percentile {
    my $self = shift;
    my $data = shift;
    
    my %h;    
    while ( my($specimen, $d) = each %$data ) { # warn Dumper $d;
        for my $action ( qw/delta_report delta_authorise/ ) {
            next unless $d->{$action}; # next unless $specimen eq 'foo';
			# next unless $specimen eq 'Slide';
=begin # using Statistics::Descriptive		
            # sort numerical vals in ascending order:
            my @vals = sort { $a <=> $b } @{ $d->{$action} }; # warn Dumper \@vals;
            # take array position of 95%:
            my $index = @vals * 0.95;  warn $index; # array pos for 95% value
            # get value for 95%:
            my $x = $vals[ int ( $index - 1 ) ]; # warn Dumper [$specimen, $x];
=cut						
			my $stat = Statistics::Descriptive::Full->new();
			$stat->add_data( @{ $d->{$action} } );
			my ($x, $index) = $stat->percentile(95); # warn Dumper [$index, $x];
            $h{$specimen}{$action} = $x;
        }
        $h{$specimen}{count} = $d->{count};
    }
    return \%h;
}

# ------------------------------------------------------------------------------
sub _sort_turnaround_data_average {
    my $self = shift;
    my $data = shift;
    
    # default order_by is specimen type:
    my $order_by = $self->query->param('order_by') || 'type';
    
	my %methods = (
		type         => \&_sort_by_specimen_type,
        totals       => \&_sort_by_totals,
        delta_r2a    => \&_sort_by_delta_r2a, # report -> auth diff
        delta_auth   => \&_sort_by_delta_authorise,
        delta_report => \&_sort_by_delta_report,
	);
    
	# get required sort method:
	my $sort_method = $methods{$order_by};
    
    # get sort order for $data as a list of $data keys:
    my $sort_order = $sort_method->($data); # warn Dumper $sort_order;
    
    # add $data key (specimen type) to its own hashref val:
    $data->{$_}->{type} = $_ for keys %$data;
    
    # create array from $data in requested sort order:
    my @sorted_data = map $data->{$_}, @$sort_order; # add $data vals in sort order
    return \@sorted_data;
}

# ------------------------------------------------------------------------------
sub _sort_by_specimen_type {
    my $data = shift; # warn Dumper $data;    
    my @sort_order = sort { $a cmp $b } keys %$data;	
	return \@sort_order;
}

# ------------------------------------------------------------------------------
sub _sort_by_totals {
    my $data = shift; # warn Dumper $data; # hashref
    
    my @sort_order = sort { 
		$data->{$a}->{count} <=> $data->{$b}->{count}
        || # 2nd sort by keys (ie specimen type) in case similar counts:
        $a cmp $b        
	} keys %$data; # warn Dumper \@sort_order;
	
	return \@sort_order;
}

# ------------------------------------------------------------------------------
sub _sort_by_delta_report {
    my $data = shift; # warn Dumper $data;
    
    my @sort_order = sort {
		$data->{$a}->{delta_report} / $data->{$a}->{count}
          <=>
        $data->{$b}->{delta_report} / $data->{$b}->{count}
        || $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
	} keys %$data;
	
	return \@sort_order;
}

# ------------------------------------------------------------------------------
sub _sort_by_delta_authorise {
    my $data = shift; # warn Dumper $data;
    
    my @sort_order = sort { 
		$data->{$a}->{delta_authorise} / $data->{$a}->{count}
          <=>
        $data->{$b}->{delta_authorise} / $data->{$b}->{count}
        || $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
	} keys %$data;
	
	return \@sort_order;
}

# ------------------------------------------------------------------------------
sub _sort_by_delta_r2a { # diff. between delta_report & delta_authorisation
    my $data = shift; # warn Dumper $data;
    
    my @sort_order = sort {
		(
            $data->{$a}->{delta_authorise} / $data->{$a}->{count} -
            $data->{$a}->{delta_report}    / $data->{$a}->{count}
        )
          <=>
		(
            $data->{$b}->{delta_authorise} / $data->{$b}->{count} -
            $data->{$b}->{delta_report}    / $data->{$b}->{count}
        )
        || $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
	} keys %$data;
	
	return \@sort_order;
}

1;