#!/usr/bin/perl
# $Id: jdata_conv.pl,v 1.4 2016/07/01 11:15:15 sqko Exp $

use strict;
use warnings;
use AFM;

my $VERSION = 0.2;
my $PROGRAM = 'jdat_conv.pl';

for my $string (@ARGV)
{
    if ($string =~ /--version/)
    {
        print "$PROGRAM is: $VERSION\n";
        exit;
    }
}


if ( scalar(@ARGV) < 5 )
{
    print "\n\n               Program for converting jdata files\n\n";
    print "\n";
    print 'Usage: '."$PROGRAM \$rig \$test \$FUNCTION \"target\" [\"source\" . . .]\n        [optional --debug --test],\n".'where $rig is the rig number';
    print ' $testno is the test number'."\n".'if an other test than the current is to be processed',"\n";
    print "The \"source\" is the colum names of the source values\n";
    print "and \"target\" is the name of the column to be replaced\n";
    print "FUNCTION is a mathematical function to be used with\n";
    print "format as shown below (with up to 8 variables):\n\n";
    print "### Function can be multiplication and addition ###\n";
    print "### eks: \'(A + 30.5) * 1.05\' means to take the  ###\n";
    print "### value in the first source name collumn      ###\n";
    print "### and add 30.5 followed by multiply by 1.05   ###\n";
    print "### For subtraction, add a negative nr          ###\n"; 
    print "### for logarithms and exponents use ln for the ###\n"; 
    print "### natural logarithm and use exp for the       ###\n"; 
    print "### inverse.  Use 2 ** 5 for the fifth power of ###\n"; 
    print "### 2 (decimal numbers can be used)             ###\n";
    print "### Remember to use single quotes!!             ###\n"; 
    print "###                                             ###\n"; 
    print "###  The order of precedence is                 ###\n"; 
    print "###  inverse (!, 1/X)  highest                  ###\n"; 
    print "###  sin                                        ###\n"; 
    print "###  cos                                        ###\n"; 
    print "###  ln (natural logarithm)                     ###\n"; 
    print "###  exponentiation (including e)               ###\n"; 
    print "###  multiplication (*)                         ###\n"; 
    print "###  addition (+)                               ###\n";
    print "###  IF{test ; expr1 ; expr2}  Lowest           ###\n";
    print "###  (expr1 is used if the test returns true),  ###\n";
    print "###  tests can be: '=','<','>','>=' and '<='.   ###\n";	    
    print "###                                             ###\n";
    print "### For division multiply with the inverse (!)  ###\n";
    print "###                                             ###\n";
    print "\nIf an illegal operation is encountered, ## is placed\n";
    print "instead of the result. If an operation includes results\n";
    print "of illegal operations (##), then the result is also considered\n";
    print "illegal and will consist of ##'s\n\n";
    print "It is advisable to use the --test option to test\n a new function with an A-value of 12.23\na B-value of 3.45 and a C-value of 26.1 (note that if\nsome variables are not used they are ignored).\n\n";
    exit;
}
my $debug = 0;
my $test = 0;

my $maxl = scalar(@ARGV) -1;
if ($ARGV[$maxl] =~ /--debug/)
{
    $debug = 1;
    pop @ARGV;
}
$maxl = scalar(@ARGV) -1;
if ($ARGV[$maxl] =~ /--test/)
{
    $test = 1;
    pop @ARGV;
}
$maxl = scalar(@ARGV) -1;
if ($ARGV[$maxl] =~ /--debug/)
{
    $debug = 1;
    pop @ARGV;
}

my $rig = $ARGV[0];

&check_run($rig);
my $testno = 0;
if (scalar(@ARGV) > 1)
{
    my $string = $ARGV[1];
    $string =~ /(\d+)/;
    my $ttest = $1;
    if (defined($ttest))
    {
        $testno = $ttest+0;
    }
}

my @source_name= ();
my $target_name = $ARGV[3];
my $function = $ARGV[2];
for (my $x = 4; $x < scalar(@ARGV); $x++)
{
    push @source_name, $ARGV[$x];
}
my $e = exp(1);

$function =~ s/exp/$e \*\* /g;
&check($function);



if ($test)
{
    $debug = 1;
    print "Using default value: A=12.23, B=3.45, C=26.1\n";
    my $y = &convert($function,'12.23','3.45','26.1');
    if ($y !~ /\#/)
    {
	$y += 0;
    }
    print $y,"\n";
    exit;
}

#### Indsaet conversion af jdata fil ####
my $dir = $AFM::publicdir.'rig'.$rig.'/'.$rig.'test'.$testno.'/';
my $jfile = $dir .'jdata';
my @list = `/bin/cat $jfile`;
my $outfile = $dir.'tmp.jdata';
#### Finding collum-id for source and target ###
my @sourceid = ();
my $targetid = 0;
my @l = split(/\s+/,$list[0]);
my $maxcol = scalar(@l);
for (my $idcount = 0; $idcount < scalar(@source_name); $idcount++)
{
    $sourceid[$idcount] = undef;
}
for (my $x = 0; $x < $maxcol; $x++)
{
    for (my $idcount = 0; $idcount < scalar(@source_name); $idcount++)
    {
	if ($l[$x] eq $source_name[$idcount])
	{
	    $sourceid[$idcount] = $x+1;
	}
    }
    if ($l[$x] eq $target_name)
    {
	$targetid = $x+1;
    }
}
my $writenew = 0;
if ($targetid == 0)
{
    $writenew = 1;
}
my $line = 0;
for my $str (@list)
{
    $line++;
    my @l = split(/\s+/,$str);
    my @xval = ();
    for (my $x = 0; $x < scalar(@sourceid); $x++)
    {
	$xval[$x] = 0;
	$xval[$x] = $l[$sourceid[$x]]+0 if (defined($sourceid[$x]));
    }
    my $t = &convert($function,@xval);
    if ($t !~ /\#/)
    {
	$t += 0;
    }
    if ($writenew)
    {
	push @l, $target_name;
	push @l, $t;
    }
    else
    {
	$l[$targetid] = $t;
    }
    for my $st (@l)
    {
	print $st,' ';
    }
    print "\n";
}
exit;



sub convert($$)
{
    my $res = 0;
    my $lfn = shift(@_);
    for (my $x = 0; $x < scalar(@_);$x++)
    {
	my $xx = '';
	if ($x==0){$xx = 'A'};
	if ($x==1){$xx = 'B'};
	if ($x==2){$xx = 'C'};
	if ($x==3){$xx = 'D'};
	if ($x==4){$xx = 'E'};
	if ($x==5){$xx = 'F'};
	if ($x==6){$xx = 'G'};
	if ($x==7){$xx = 'H'};
	$lfn =~ s/$xx/$_[$x]/g;
    }
    warn "Start: ",$lfn,"\n" if ($debug);
    while ($lfn =~ /\(([\w\s\.\-\+\*\!\=\<\>\;\{\}\#]+)\)/ ) 
    {
	my $llfn = $1;
	my $res = &convert($llfn);
	$lfn =~ s/\([\w\s\.\-\+\*\!\<\=\>\;\{\}\#]+\)/$res/;
    }
    $lfn =~ s/\-\s*\-//g;  ### -- -> + ##
    while ($lfn =~ /\!\s*([e\d\.\-\+\#]+)/)
    {
	my $a = $1;
	if (($a !~ /\#/) && ($a != 0))
	{
	    $a = 1 / $a;
	    $lfn =~ s/\!\s*[e\d\.\-\+]+/$a/;
	}
	else
	{
	    $lfn =~ s/\!\s*[e\d\.\-\+\#]+/##/;
	}
    }
    while ($lfn =~ /sin\s*([e\d\.\-\+\#]+)/)
    {
	my $a = $1;
	if ($a =~ /\#/)
	{
	    $lfn =~ s/sin\s*[e\d\.\-\+\#]+/##/;
	}
	else
	{	
	    $a = sin($a);
	    $lfn =~ s/sin\s*[e\d\.\-\+]+/$a/;
	}
    }
    while ($lfn =~ /cos\s*([e\d\.\-\+\#]+)/)
    {
	my $a = $1;
	if ($a =~ /\#/)
	{
	    $lfn =~ s/cos\s*[e\d\.\-\+\#]+/##/;
	}
	else
	{	
	    $a = cos($a);
	    $lfn =~ s/cos\s*[e\d\.\-\+]+/$a/;
	}
    }
    while ($lfn =~ /ln\s*([e\d\.\-\+\#]+)/)
    {
	my $a = $1;
	if (($a !~ /\#/) && ($a > 0))
	{
	    $a = log($a);
	    $lfn =~ s/ln\s*[e\d\.\-\+]+/$a/;
	}
	else
	{
	    $lfn =~ s/ln\s*[e\d\.\-\+\#]+/##/;
	}
    }
    while ($lfn =~ /([e\d\.\-\+\#]+)\s+\*\*\s+([e\d\.\+\-\#]+)/)
    {
	my $a1 = $1;
	my $a2 = $2;
	if (($a1 !~ /\#/) && ($a2 !~ /\#/))
	{
	    my $lres = $a1 ** $a2;
	    $lfn =~ s/[e\d\.\-\+]+\s+\*\*\s+[e\d\.\-\+]+/$lres/;
	}
	else
	{
	    $lfn =~ s/[e\d\.\-\+\#]+\s+\*\*\s+[e\d\.\-\+\#]+/##/;
	}
    }
    while ($lfn =~ /([e\d\.\-\+\#]+)\s+\*\s+([e\d\.\-\+\#]+)/)
    {
	my $a1 = $1;
	my $a2 = $2;
	if (($a1 !~ /\#/) && ($a2 !~ /\#/))
	{
	    my $lres = $a1 * $a2;
	    $lfn =~ s/[e\d\.\-\+]+\s+\*\s+[e\d\.\-\+]+/$lres/;
	}
	else
	{
	    $lfn =~ s/[e\d\.\-\+\#]+\s+\*\s+[e\d\.\-\+\#]+/##/;
	}
    }
    while ($lfn =~ /([e\d\.\-\+\#]+)\s+\+\s+([e\d\.\-\+\#]+)/)
    {
	my $a1 = $1;
	my $a2 = $2;
	if (($a1 !~ /\#/) && ($a2 !~ /\#/))
	{
	    my $lres = $a1 + $a2;
	    $lfn =~ s/[e\d\.\-\+]+\s+\+\s+[e\d\.\-\+]+/$lres/;
	}
	else
	{
	    $lfn =~ s/[e\d\.\-\+\#]+\s+\+\s+[e\d\.\-\+\#]+/##/;
	}
    }
    while ($lfn =~ /IF\{([\w\+\-\.\s\=\<\>]+)\;([\w\+\-\.\s\#]+)\;([\w\s\.\+\-\#]+)\}/)
    {
	my $test = $1;
	print "If: $test " if ($debug);
	my $a1 = $2;
	my $a2 = $3;
	print "then $a1 else $a2" if ($debug);
	my $ttest = undef;
	if ($test =~ /([\w\.\+\-]+)\s+\=\s+([\w\.\+\-]+)/)
	{
	    $ttest = 0;
	    my $ta = $1+0;
	    my $tb = $2+0;
	    if ($ta == $tb){$ttest = 1};
	}
	if ($test =~ /([\w\.\+\-]+)\s+\<\s+([\w\.\+\-]+)/)
	{
	    $ttest = 0;
	    my $ta = $1+0;
	    my $tb = $2+0;
	    if ($ta < $tb){$ttest = 1};
	}
	if ($test =~ /([\w\.\+\-]+)\s+\>\s+([\w\.\+\-]+)/)
	{
	    $ttest = 0;
	    my $ta = $1+0;
	    my $tb = $2+0;
	    if ($ta > $tb){$ttest = 1};
	}
	if ($test =~ /([\w\.\+\-]+)\s+\<\=\s+([\w\.\+\-]+)/)
	{
	    $ttest = 0;
	    my $ta = $1+0;
	    my $tb = $2+0;
	    if ($ta <= $tb){$ttest = 1};
	}
	if ($test =~ /([\w\.\+\-]+)\s+\>\=\s+([\w\.\+\-]+)/)
	{
	    $ttest = 0;
	    my $ta = $1+0;
	    my $tb = $2+0;
	    if ($ta >= $tb){$ttest = 1};
	}
	unless (defined($ttest))
	{
	    warn "Unrecognised bolean test encountered: $test\n";
	    warn "in line $line\n" unless ($test);
	    exit;
	}
	if ($ttest)
	{
	    print "; True, return $a1\n" if ($debug);
	    $lfn = $a1;
	}
	else
	{
	    print "; false, return $a2\n" if ($debug);
	    $lfn = $a2;
	}
    }
    warn "End: ",$lfn,"\n" if ($debug);
    if ($lfn =~ /[\(\*\)\}\{\;\<\>\=]+/)
    {
	die "Error, poosible reason wrong use of paranthesis!!\n";
    }
    return $lfn;
}



sub check($)
{
    my $f = $_[0];
    my @l = split(//,$f);
    my $cl = 0;
    my $cr = 0;
    for my $chr (@l)
    {
	if ($chr eq '(') {$cl++};
	if ($chr eq ')') {$cr++};
    } 
    if ($cl != $cr)
    {
	die "Paranthesis does not match!!\n";
    }
}
