package RFC::Redundancy;
#$Id: Redundancy.pm,v 1.8 2025/02/21 06:06:58 sqko Exp $
#################################################################
#
#
#       RFC::Redundancy
#
#
#
# This class defines a special filter deivce which can be used 
# to evaluate a number of inputs and if they agree in value
# the average of the input values are returned.
# If one or more inputs have values which lie outside the defined
# range, the average is only calculated based on the 'good' values
#
# If the number of inputs whihc is considered 'bad' is larger than
# the maximum allowed, the status of the filter will be set to false
# and the value will again be based on the average of all inputs.
#
# The maximum allowed number of bad inputs has to be less than half
# the number of inputs (rounded down).
#
# The bool() function returns true if the number of inputs with
# 'bad' values is not larger than the maximum allowed bad inputs
#
# To determine if an input is 'bad', the value is compared to
# the average of the other inputs, and if the value is further
# away from that average than the 'limit' value, the input
# is considered 'bad'.
#
# Note that input values can have such a distribution that none
# of the individual inputs can be considered 'good' although
# all are within the limit from the average of all the inputs, 
# but none of the inoputs are within the limit of the average
# defined by the remaining inputs!
#
#
# be avare that setting the limit to 0 effectively disabeles the test
# for 'badness' of an input (and in which case the bool() funciton
# will always return true and the read value will be the average
# of all inputs.
#
# This class also extends the test() member function so that in order
# for an instance of this class to test true, 
# the bool() function must return true as well as the test() 
# function on each input.
#
# To obtain an instance of this class call the costructor:
#
# my $id = RFC::Redundancy->new($name,$rig);
#
# The RFC::Reduncancy class defines an additional member function
# which is the $id->badness() function which returns the number
# of inputs considred to be 'bad'
# 
#################################################################

use strict;
use warnings;
use RFC::Header;
use RFC::BaseDevice;
use POSIX;
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'} = 'Redundancy filter'; 
    $self->{'_setup_tags'} = ['class','mode','inputs','device_type','maximum_bad','limit'];
    $self->{'_reload_tags'} = ['class','inputs'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_monitor_rows'} = '3,5,7';
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
        'inputs' => 'number of inputs',
	'device_type' => 'Type of raw device',
	'maximum_bad' => 'Number of inputs which can have values outside range before bool() returns false',
	'limit', => 'Maximum deviation from the mean of the rest of the inputs an input may have',
    };
    $self->{'_default'} = {
        'mode' => 'Redundancy',
        'inputs' => 3,
        'device_type' => 'simplechannel',
	'maximum_bad' => 0,
	'limit' => 0,
    };
    bless $self,$class;
    $self->{'_values_class'} = [RFC::Device::list_filter()];
    $self->{'_values_device_type'} = ['',$self->rig->list_types_nofilter()];
    $self->{'_section'} = 'filter_'.$self->name;
    $self->{'_values_inputs'} = [2,3,4,5,6,7,8,9,10,11];
    foreach my $tag ($self->setup_tags)
    {
        $self->{'_'.$tag} = $self->get_default($tag);
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    }
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_device'} = ['',@list];
    $self->{'_values_read_function'} = ['read'];
    $self->{'_read_names'} = ['read','badness','bool'];
    $self->{'_values_maximum_bad'} = [0];
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = 'input_device_'.$x;
        push @{$self->{'_setup_tags'}},$tag;
        $tag = 'input_device_'.$x;
        $self->{'_'.$tag} = $self->get_default($tag);
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
        $self->{'_desc'}->{$tag} = 'Input device '.$x;
        $self->{'_values_'.$tag} = ['',@list];
    }
    $self->{'_info_string'} = 'Note that filter devices used in a control chain only works correctly if they are included (enabled)';
    @list = ();
    my $max = POSIX::ceil($self->{'_inputs'}/2);
    $max = 0 if ($max < 0);
    for (my $x = 0; $x < $max; $x++)
    {
	push @list,$x;
    }
    $self->{'_values_maximum_bad'} = [@list] if (@list);
    $self->{'_maximum_bad'} = $max if ($self->{'_maximum_bad'} > $max);
    $self->rig->register_device($self->{'_device_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub init
{
    my $self = shift;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        next if ($self->{'_dev_'.$x}); 
        my $tag = '_input_device_'.$x;
        my $dev = $self->rig->get_device($self->{'_device_type'},$self->{$tag});
        unless ($dev)
        {
            $dev = $self->rig->init_device($self->{'_device_type'},$self->{$tag});
            $dev->readstring_ignore(1) if ($dev);
        }
        if ($dev)
        {
            $dev->debug($self->debug);
            $self->{'_dev_'.$x} = $dev; 
            $dev->attatch_observer(\$self);
        }
        $self->die("Could not initialise Logic device of type '".$self->{'_device_type'}."' with name: '".$self->{'_device'}."'") unless ($self->{'_dev_'.$x});
    }
    return $self;
}

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    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 readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    ### allow call to get 'mode' for undefined devices ###
    return 'Input' if ($tag eq 'mode');
}

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_full()
{
    my $self = shift;
    $self->init();
    my $res = $self->test();
    $res = 0 unless ($res && $self->bool());
    return $res;
}

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});
    }
    push @arr,'Output device: '.$self->{'_dev'}->print_config() if ($self->{'_dev'});
    return join(', ',@arr);
}

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();
    push @arr,'Filter device "'.$self->name.'" of type "'.$type.'": ';
    push @arr,'Value: '.$self->read($data);
    push @arr,'Badness: '.$self->badness($data);
    push @arr,'Status: '.$self->bool($data);
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        my $val = $self->{$tag}->read($data);
        my $str = $self->{$tag}->test_string($data);
        chomp $str;
        push @arr,'Input device '.$x.': Value: '.$val.' , '.$str;
    }
    my $string .= join("\n",@arr)."\n";
    return $string;
}

sub monitor
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = shift;
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    my $bad = $self->badness($data);
    my $status = $self->bool($data);
    return join(' ','Value',$val,'Badness',$bad,'Status',$status);
}


sub badness
{
    my $self = shift;
    my @vals = ();
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        $vals[$x] = $self->{$tag}->read(@_);
	$self->writedebug("Value for device ".$self->{$tag}->name.': '.$vals[$x]) if ($self->debug > 2);
    }
    my $bad = 0;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $sum = 0;
	my $n = 0;
	for (my $y = 0; $y < $self->{'_inputs'}; $y++)
	{
	    next if ($x == $y);
	    $n++;
	    $sum += $vals[$y];
	}
	my $avg = $sum/$n;
	next if (abs($vals[$x] - $avg) < $self->{'_limit'});
	$self->writedebug("Value for device ".$self->{'_dev_'.$x}->name.': '.$vals[$x].' was outside range device "'.$self->name.'"') if ($self->debug);
	$bad++;
    }
    return $bad;
}


sub bool
{
    my $self = shift;
    my @vals = ();
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        $vals[$x] = $self->{$tag}->read(@_);
	$self->writedebug("Value for device ".$self->{$tag}->name.': '.$vals[$x]) if ($self->debug > 2);
    }
    return 1 if (@vals == 1);
    return 1 unless ($self->{'_limit'});
    my $bad = $self->badness(@_);
    my $res = 1;
    $res = 0 if ($bad > $self->{'_maximum_bad'});
    $self->writedebug("Status for device ".$self->name.': '.$res) if ($self->debug);
    return $res;
}

sub read
{
    my $self = shift;
    my @vals = ();
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
        my $tag = '_dev_'.$x;
        $vals[$x] = $self->{$tag}->read(@_);
	$self->writedebug("Value for device ".$self->{$tag}->name.': '.$vals[$x]) if ($self->debug > 2);
    }
    my $bad = 0;
    my @good_inp = ();
    return $vals[0] if (@vals == 1);
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $sum = 0;
	my $n = 0;
	for (my $y = 0; $y < $self->{'_inputs'}; $y++)
	{
	    next if ($x == $y);
	    $n++;
	    $sum += $vals[$y];
	}
	my $avg = $sum/$n;
	$good_inp[$x] = 1;
	next unless ($self->{'_limit'});
	next if (abs($vals[$x] - $avg) < $self->{'_limit'});
	$self->writedebug("Value for device ".$self->{'_dev_'.$x}->name.': '.$vals[$x].' was outside range device "'.$self->name.'"') if ($self->debug);
	$bad++;
	$good_inp[$x] = 0;
    }
    my $sum = 0;
    my $n = 0;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	next unless ($bad > $self->{'_maximum_bad'} || $good_inp[$x]);
	$n++;
	$sum += $vals[$x];
    }
    my $avg = $sum/$n;
    $self->writedebug("Value for device ".$self->name.': '.$avg) if ($self->debug);
    return $avg;
}

sub readstring
{
    my $self = shift;
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    my $bool  = $self->bool($data);
    my $bad  = $self->badness($data);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name.'_value',$t,time,$val,$self->name.'_status',$t,time,$bool,$self->name.'_badness',$t,time,$bad);
    $self->writedebug($res) if ($self->debug > 1);
    return $res;
}
