package RFC::Spline;
#$Id: Spline.pm,v 1.13 2015/09/30 06:12:14 sqko Exp $
###############################################################
#
# Package RFC::Spline
#
# This module defined the behaviour of a spline interpolation.
#
# The intended use of RFC::Spline instances is to correct measured
# values according to a callibration table and/or to convert a measured
# value to an other format (for instance given a conversion table linking 
# measured voltages to pressures a splineinterpolation can be used to
# obtain the pressure given a measured voltage).
# 
# To obtain a RFC::Spline instance call the constructor:
#
# $id = RFC::Spline->new($data);
#
# where $data is a string containing a list of spline data.
# the list must be formatted in the form of a number of lines with
# a single x and y cordinate on each line. The data must represent a 
# continious, single valued function
# (that is for each x there is one and only one y and the function 
# is without 'jumps' like seen in the function 1/x).
# The x and y values must be separated by space and/or tabs and 
# lines must be separated by newlines.
# Note that if more than 2 values are found on a line only the two first
# are used and only valid lines are used (lines with less than 2 detected numbers
# are discarded!).
#
# An RFC::Spline instance allows numbers to be converted according to
# the spline table. Thus to convert a given value simply call the 
# 'value' public member function. 
#
# $newval = $id->value($oldval);
#
#
# The following public member functions exists:
#
# $id->value($)    Returns the interpolated value based on supplied argument
#                  which must be a number!
# $id->data()      Returns the spline table used in the calculations.
#
#
# If only 2 sets of numbers are given in the spline table, the relation is assumed to
# be a linear one and no spline interpolation is performed. Instead 
# a spmple linear interpolation is used.
#
# The same is the case for input values outside the defined data range. 
# In those cases the first or last 2 data points are used in a linear 
# interpolation. Notice that in general it is poor form to interpolate
# values outside the defined range! 
#
#
# Below is an exaple of how a spline table may look:
#
#
# -0.5 -0.1
#
# 0    0.1
# 
# 1    3
#
# 1.5  5.7
#
#
###############################################################
use strict;
use warnings;
use Debug;
use RFC::Header;
use SemaforeFile;
use File::Touch;
our @ISA = qw(Debug);

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->{'_data'} = [];
    bless $self,$class;
    if (@_)
    {
	my $data = shift;
	if ($data)
	{
	    my @arr = split(/[\s\t]*\n[\s\t\n]*/,$data);
	    my %l2 = ();
	    foreach my $l (@arr)
	    {
		## Only include lines with 2 or more cols ##
		next unless ($l);
		my @list = split(/[\s\t]+/,$l);
		if (@list > 1)
		{
		    $l2{$list[0].' '.$list[1]} = $list[0];
		}
	    }
	    ### Use ordered list ###
	    @{$self->{'_data'}} = sort {$l2{$a} <=> $l2{$b}} keys %l2;
	}
    }
    $self->{'_file'} = SemaforeFile->new('/tmp/splinedata_'.$$.'.dat','/home/celltest/spline.lock');
    return $self;
}

sub DESTROY
{
    my $self = shift;
    $self->{'_file'}->DESTROY();
    $self->{'_file'} = undef;
    return undef;
}

sub debug
{
    my $self = shift;
    $self->SUPER::debug(@_);
    if (@_)
    {
        $self->{'_file'}->debug(@_);
    }
    return $self->{'_debug'};
}

sub lineinterpol()
{
    ### Handle linear relation locally without external call ###
    my $self = shift;
    my $l1 = shift;
    my $l2 = shift;
    my $val = shift;
    my ($x1,$y1) = split(/[\s\t]+/,$l1);
    my ($x2,$y2) = split(/[\s\t]+/,$l2);
    my $dy = $y2-$y1;
    my $dx = $x2-$x1;
    $self->die("Error! Spline table with x-range of zero detected!") unless ($dx);
    my $slope = $dy/$dx;
    my $intercept = $y1 - $slope * $x1;
    my $res = $intercept + $slope * $val;
    $self->writedebug("Result of linear interpolation: '$res'.") if ($self->debug);
    return $res;
}

sub value($)
{
    my $self = shift;
    my $val = shift;
    my @list = @{$self->{'_data'}};
    unless (@list && @list > 1)
    {
	$self->writedebug("Returning original value '$val' as no or only one spline data point found!") if ($self->debug);
	return $val 
    }
    foreach (@list)
    {
	### Remove leading blanks ##
	s/^[\s\t]*//;
    }
    if (@list == 2)
    {
	$self->writedebug("Doing linear interpolation of '$val'.") if ($self->debug);
	return $self->lineinterpol($list[0],$list[1],$val);
    }
    ### Check for negative out of bound condition ###
    my ($x1,$y1) = split(/[\s\t]+/,$list[0]);
    if ($val < $x1)
    {
	$self->writedebug("Doing linear interpolation of '$val' as input is below data range.") if ($self->debug);
	return $self->lineinterpol($list[0],$list[1],$val);
    }   
    ### Check for positive out of bound condition ###
    my ($x2,$y2) = split(/[\s\t]+/,$list[-1]);
    if ($val > $x2)
    {
	$self->writedebug("Doing linear interpolation of '$val' as input is above data range.") if ($self->debug);
	return $self->lineinterpol($list[-2],$list[-1],$val);
    }
    ### Handle all other cases through external call ###
    $self->writedebug("Doing spline interpolation of '$val'.") if ($self->debug);
    $self->{'_file'}->lock_ex();
    if ($self->{'_file'}->exist() && -w $self->{'_file'}->filename)
    {
	$self->{'_file'}->writeline(@list);
    }
    elsif (!$self->{'_file'}->exist())
    {
	$self->{'_file'}->writeline(@list);
	chmod 0666,$self->{'_file'}->filename;
    }
    else
    {
	$self->die("Could not open splinefile ".$self->{'_file'}->filename." as it was not writable by ".getpwuid($<));
    }
    my $cmd = $spline.' '.$self->{'_file'}->filename.' '.$val;
    $self->writedebug("Calling '$cmd'") if ($self->debug);
    unless (-e $spline && -x $spline)
    {
	unlink $self->{'_file'}->filename if ($self->{'_file'}->exist());
	$self->die("ERROR: Spline interpolation program $spline not found or not executable by userid $<!\n") 
    }
    my $res = `$cmd`;
    if (defined($res) && $res =~ /^[\s\t]*([\d\.\+\-eE]+)[\s\t]*$/)
    {
	$res = $1;
    }
    unlink $self->{'_file'}->filename if ($self->{'_file'}->exist());
    $self->{'_file'}->lock_un();
    $self->writedebug("Result of spline: '$res'") if ($self->debug);
    return $res;
}

sub data()
{
    my $self = shift;
    return join("\n",@{$self->{'_data'}});
}

return 1;
