package RFC::Math;
#$Id: Math.pm,v 1.23 2023/05/25 04:55:45 sqko Exp $
######################################################################
#
#
#              RFC::Math
#
#  The RFC::Math module defines a number of arithmetic devices which
#  all accepts one or more RFC devices as inputs and performs
#  the arithmetic function on the values obtained from the input
#  devices read funstions.
#
#  The RFC::Math devices are purely intended to be used in rare cases
#  where control logic / feedback loops require calculations of measured
#  device values, and NOT intended to be used for data logging purposes.
#
#  As RFC::Math devices are virtual, they are not included in the 
#  normal datalogging (and accordingly readstring_ignore(1) is set
#  uppon device instantiation). However they must be enabled
#  in the rig configuration to work properly.
#
#  Interdevice control flow is implemented by the obsever pattern.
#  This ensures that input devices does not need to know that they
#  are used as inputs to math devices and any 
#  command executed on a RFC::Math input device automatically forces 
#  the RFC::Math to get updated although this has no direct effect 
#  (other than potentially forcing devices further 'down the chain'
#  to be updated).
#
#  Notice however that great care must be taken when including math
#  devices as it is easy to configure a situation where circular
#  references will occour (essentially causing Perl's version of
#  a stack overflow).
#
#  Thus it is recommended that if math devices is to be included in 
#  a rig's control system, make a detailed schematic of the control
#  flow diagram with unique names of each individual math device
#  as well as all other normal devices  
#  thus ensuring that the correct inputs and device names are chosen 
#  when configuring the rig.
#
#  To obtain an instance of a RFC::Math object call one of the constructors:
#
#  my $id = RFC::Math_add->new($name,$rig);
#
#  my $id = RFC::Math_sub->new($name,$rig);
#
#  my $id = RFC::Math_multily->new($name,$rig);
#
#  my $id = RFC::Math_divide->new($name,$rig);
#
#  my $id = RFC::Math_log->new($name,$rig);
#
#  my $id = RFC::Math_exp->new($name,$rig);
#
#  my $id = RFC::Math_root->new($name,$rig);
#
#  my $id = RFC::Math_abs->new($name,$rig);
#
#  my $id = RFC::Math_inv->new($name,$rig);
#
#  RFC::Math devices does not allow caching, however the underlying (input)
#  devices may do so by themselves.
#
#  Notice that some of the RFC::Math devices behaves slightly different than 
#  the normal arithmetic functions they implement.
#  This difference is due to the potential consequences of division by zero 
#  or similar errors.
#  
#  Thus RFC::Math::divide returns 0 if the divisor is 0,
#  RFC::Math::log and RFC::Math::root returns 0 for all non-positive inputs (including 0)
#  and RFC::Math::inv returns 0 if the input is 0.
#
######################################################################

use strict;
use warnings;
use RFC::Header;
use RFC::BaseDevice;
use RFC::Cache;
our @ISA = qw(RFC::BaseDevice);

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 $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'Generic arithmetic device'; 
    $self->{'_setup_tags'} = ['class','mode','inputs'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_reload_tags'} = ['class','mode','inputs'];
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
        'inputs' => 'number of inputs',
        'class' => 'Arithmetic operator',
	'offset' => 'Nummeric offset added to result of inputs',
	};
    $self->{'_default'} = {
        'mode' => 'Automatic',
        'class' => 'Add',
        'inputs' => 2,
	'offset' => 0,
    };
    bless $self,$class;
    $self->{'_html_template'} = 'Math.tt';
    $self->{'_values_class'} = [RFC::Device::list_Math()];
    $self->{'_values_inputs'} = [2];
    $self->{'_values_mode'} = ['Math'];
    $self->{'_section'} = 'Math_'.$self->name;
    $self->{'_info_string'} = 'Note that math devices only works correctly if they are included (enabled)';
    return $self;
}

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $self->init();
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        $self->{$tag}->Accept($visitor) if ($self->{$tag});
    }
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        push @arr,'Input device '.$x.': '.$self->{$tag}->print_config() if ($self->{$tag});
    }
    return join(', ',@arr);
}

sub local_init()
{
    #### Stub function intended for loverloading for any impelmention dependent initialisations ###
    my $self = shift;
    return $self;
}

sub get_vals
{
    my $self = shift;
    my @res = ();
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
	my $val = 0;
	my $fn_name = $self->{'_read_function_'.$x};
	$val = $self->{$tag}->read_named($fn_name,@_) if ($self->{$tag});
	$val = 0 unless (defined($val) && $val =~ /\d/);
	$val = $val * $self->{'_input_factor_'.$x};
	$res[$x] = $val;
    }
    return @res;
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    ### allow call to get 'mode' for undefined devices ###
    return 'Automatic' if ($tag eq 'mode');
}

sub setup_tags()
{
    my $self = shift;
    $self->init();
    my @res = ();
    @res = @{$self->{'_setup_tags'}} if ($self->{'_setup_tags'});
    return (@res,'comments');
}

sub init()
{
    my $self = shift;
    return $self if ($self->{'_has_init'});
    $self->{'_has_init'} = 1;
    $self->load_conf();
    my @typelist = ($self->rig->list_types_nofilter());
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	push @{$self->{'_setup_tags'}},'device_type_'.$x,'device_'.$x,'input_factor_'.$x,'read_function_'.$x;
	push @{$self->{'_reload_tags'}},'device_type_'.$x;
	$self->{'_values_device_type_'.$x} = [@typelist];
	$self->{'_desc'}->{'device_'.$x} = 'Input device '.$x;
	$self->{'_desc'}->{'device_type_'.$x} = 'Device type for input '.$x;
	$self->{'_default'}->{'device_type_'.$x} = 'simplechannel';
	$self->{'_desc'}->{'input_factor_'.$x} = 'Factor multiplied on value from input '.$x.' before math operation';
	$self->{'_default'}->{'input_factor_'.$x} = 1;
	$self->{'_default'}->{'read_function_'.$x} = 'read';
	$self->{'_desc'}->{'read_function_'.$x} = 'Device function to use for read operations for device '.$x,
	$self->{'_values_read_function_'.$x} = ['read'];
    }
    $self->load_conf(); ### Reload config after setting input device keys ###
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	next if ($self->{'_dev_'.$x});
	my $type = $self->{'_device_type_'.$x};
	next unless ($type);
	my @list = $self->rig->avaliable_devices($type);
	### Include any math devices as possible inputs ###
	foreach ($self->rig->avaliable_devices('math'))
	{
	    next unless ($_);
	    push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
	}
	### Remove any duplicates in list (may happen as logic devices register as normal devices) ###
	my %hash = ();
	foreach (@list)
	{
	    $hash{$_} = 1;
	}
	@list = ();
	foreach my $key (sort keys %hash)
	{
	    push @list,$key;
	}
	$self->{'_values_device_'.$x} = ['',@list];
	my $name = $self->{'_device_'.$x};
	next unless ($name);
	my $dev = $self->rig->get_device($type,$name);
        $dev = $self->rig->get_device('filter',$name) unless ($dev);
        $dev = $self->rig->get_device('math',$name) unless ($dev);
        $dev = $self->rig->get_device('logic',$name) unless ($dev);
	unless ($dev)
	{
	    $dev = $self->rig->init_device($type,$name);
	    $dev = $self->rig->init_device('filter',$name) unless ($dev);
	    $dev = $self->rig->init_device('math',$name) unless ($dev);
	    $dev = $self->rig->init_device('logic',$name) unless ($dev);
	    $dev->readstring_ignore(1) if ($dev);
	}
	if ($dev)
	{
	    my @arr = $dev->read_names();
	    $self->{'_values_read_function_'.$x} = [@arr];
	    $self->{'_dev_'.$x} = $dev;
	    $dev->attatch_observer(\$self);
	}
    }
    return $self;
}

sub observe
{
    my $self = shift;
    my $action = shift; 
    return $self->notify($action,@_);
}


sub read
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    return $self->read_nocache($data);
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    ### The default math device always returns 1 on read.... ###
    $self->{'_last_read'} = Time::HiRes::time;
    return 1;
}

sub test()
{
    my $self = shift;
    $self->init();
    my $res = 1;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        $res = 0 unless ($self->{$tag}->test);
    }
    return $res;
}

sub test_string()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    $self->init(); 
    my @arr = ();
    my $type = $self->type();
    my $string = 'Math device "'.$self->name.'" of type "'.$type.'": ';
    my $val = $self->read($data);
    push @arr,'Value: '.$val;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        my $str = $self->{$tag}->test_string($data);
        chomp $str;
        push @arr,'Input device '.$x.': '.$str;
    }
    $string .= join(', ',@arr)."\n";
    return $string;
}


package RFC::Math_add;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_setup_tags'} = ['class','mode','inputs','offset'];
    $self->{'_type'} = 'Arithmnitic sum device';
    $self->{'_default'}->{'class'} = 'Add';
    $self->{'_class'} = 'Add';
    $self->{'_values_inputs'} = [2,3,4,5,6,7,8,9];
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my $res = $self->{'_offset'};
    foreach my $val ($self->get_vals(@_)) 
    {
	$res += $val;
    }
    $self->{'_last_read'} = Time::HiRes::time;
    return $res;
}

package RFC::Math_multiply;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic multiplication';
    $self->{'_default'}->{'class'} = 'Multiply';
    $self->{'_values_inputs'} = [2,3,4,5,6,7,8,9];
    $self->{'_inputs'} = 2;
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my $res = 1;
    foreach my $val ($self->get_vals(@_)) 
    {
	$res = $res * $val;
    }
    $self->{'_last_read'} = Time::HiRes::time;
    return $res;
}


### Subtract and divide only accepts 2 input devices ###

package RFC::Math_sub;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic subtraction';
    $self->{'_setup_tags'} = ['class','mode','offset'];
    $self->{'_default'}->{'class'} = 'Subtract';
    $self->{'_inputs'} = 2;
    $self->{'_info_string'} = 'Subtracts the value of device 1 from the value of device 0! Note that math devices only works correctly if they are included (enabled)';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    $self->{'_last_read'} = Time::HiRes::time;
    return $self->{'_offset'} + $vals[0] - $vals[1];;
}

package RFC::Math_divide;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic division';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Divide';
    $self->{'_inputs'} = 2;
    $self->{'_info_string'} = 'Divides the value of device 0 with the value of device 1! Note that math devices only works correctly if they are included (enabled). Returns 0 if divisor or dividend is 0 (no divide by 0 error).';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    $self->{'_last_read'} = Time::HiRes::time;
    foreach my $val (@vals)
    {
	return 0 unless ($val); ### Avoid divide by 0 errors ###
    }
    return $vals[0] / $vals[1];
}


### Logarithms and exponeentials etc            ###
### These devices only accepts one input device ###

package RFC::Math_log;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic logarithm';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Log';
    $self->{'_values_inputs'} = [1];
    $self->{'_inputs'} = 1;
    $self->{'_info_string'} = 'returns the natural logarithm of the value of the input device! Note that math devices only works correctly if they are included (enabled). Returns 0 if device value is 0 (no log(0) error!)';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    my $val = $vals[0];
    $self->{'_last_read'} = Time::HiRes::time;
    return 0 unless ($val && $val > 0); ### Avoid log(0) errors ###
    return log($val);
}

package RFC::Math_exp;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic exponential';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Exp';
    $self->{'_values_inputs'} = [1];
    $self->{'_inputs'} = 1;
    $self->{'_info_string'} = 'Returns the natural eponential of the input device value! Note that math devices only works correctly if they are included (enabled)';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    $self->{'_last_read'} = Time::HiRes::time;
    return exp($vals[0]);
}

package RFC::Math_root;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic square root';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Root';
    $self->{'_values_inputs'} = [1];
    $self->{'_inputs'} = 1;
    $self->{'_info_string'} = 'Returns the square root of the input device value! Note that math devices only works correctly if they are included (enabled). Returns 0 for all negative input values!';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    my $val = $vals[0];
    $self->{'_last_read'} = Time::HiRes::time;
    return 0 unless ($val && $val > 0);  ## No sqrt(neg) errors ##
    return sqrt($val);
}

package RFC::Math_abs;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic absolute value';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Abs';
    $self->{'_values_inputs'} = [1];
    $self->{'_inputs'} = 1;
    $self->{'_info_string'} = 'Returns the absolute value of the input device value! Note that math devices only works correctly if they are included (enabled).';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    my $val = $vals[0];
    $self->{'_last_read'} = Time::HiRes::time;
    return -$val if ($val && $val < 0);
    return $val;
}

package RFC::Math_inv;
our @ISA = qw(RFC::Math);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Arithmnitic inverse';
    $self->{'_setup_tags'} = ['class','mode'];
    $self->{'_default'}->{'class'} = 'Inv';
    $self->{'_values_inputs'} = [1];
    $self->{'_inputs'} = 1;
    $self->{'_info_string'} = 'Returns the inverse value of the input device value! Note that math devices only works correctly if they are included (enabled).';
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->init();
    my @vals = $self->get_vals(@_);
    my $val = $vals[0];
    $self->{'_last_read'} = Time::HiRes::time;
    return 0 if (!defined($val) || $val == 0);
    return 1/$val;
}

return 1;
