view release on metacpan or  search on metacpan

lib/AI/FuzzyEngine/Set.pm  view on Meta::CPAN

package AI::FuzzyEngine::Set;

use 5.008009;
use version 0.77; our $VERSION = version->declare('v0.2.2');

use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed weaken);
use List::MoreUtils;

sub new {
    my ($class, @pars) = @_;
    my $self = bless {}, $class;

    $self->_init(@pars);

    return $self;
}

sub name        { shift->{name}        }
sub variable    { shift->{variable}    }
sub fuzzyEngine { shift->{fuzzyEngine} }
sub memb_fun    { shift->{memb_fun}    }

sub degree {
    my ($self, @vals) = @_;

    if (@vals) {
        # Multiple input degrees are conjuncted: 
        my $and_degree  = $self->fuzzyEngine->and( @vals );

        # Result counts against (up to now) best hit
        my $last_degree = $self->{degree};
        $self->{degree} = $self->fuzzyEngine->or( $last_degree, $and_degree );
    };

    return $self->{degree};
}

# internal helpers, return @x and @y from the membership functions
sub _x_of ($) { return @{shift->[0]} };
sub _y_of ($) { return @{shift->[1]} };

sub _init {
    my ($self, %pars) = @_;
    my %defaults = ( name        => '',
                     value       => 0,
                     memb_fun    => [[]=>[]], # \@x => \@y
                     variable    => undef,
                     fuzzyEngine => undef,
                   );

    my %attrs = ( %defaults, %pars );

    my $class = 'AI::FuzzyEngine';
    croak "fuzzyEngine is not a $class"
        unless blessed $attrs{fuzzyEngine} && $attrs{fuzzyEngine}->isa($class);

    $class = 'AI::FuzzyEngine::Variable';
    croak "variable is not a $class"
        unless blessed $attrs{variable} && $attrs{variable}->isa($class);

    croak 'Membership function is not an array ref'
        unless ref $attrs{memb_fun} eq 'ARRAY';

    $self->{$_}       = $attrs{$_} for qw( variable fuzzyEngine name memb_fun);
    weaken $self->{$_}             for qw( variable fuzzyEngine );

    $self->{degree} = 0;

    my @x = _x_of $self->memb_fun;
    croak 'No double interpolation points allowed'
        if List::MoreUtils::uniq( @x ) < @x;

    $self;
}

sub _copy_fun {
    my ($class, $fun) = @_;
    my @x = @{$fun->[0]}; #    my @x = _x_of $fun;, improve speed
    my @y = @{$fun->[1]};
    return [ \@x => \@y ];
}

sub _interpol {
    my ($class, $fun, $val_x) = @_;

    my @x = @{$fun->[0]}; # speed
    my @y = @{$fun->[1]};

    if (not ref $val_x eq 'PDL') {

        return $y[ 0] if $val_x <= $x[ 0];
        return $y[-1] if $val_x >= $x[-1];

        # find block
        my $ix = 0;
        $ix++ while $val_x > $x[$ix] && $ix < $#x;
        # firstidx takes longer (156ms vs. 125ms with 50_000 calls)
        # my $ix = List::MoreUtils::firstidx { $val_x <= $_ } @x;

        # interpolate
        my $fract  = ($val_x - $x[$ix-1]) / ($x[$ix] - $x[$ix-1]);
        my $val_y  = $y[$ix-1]  +  $fract * ($y[$ix] - $y[$ix-1]);

        return $val_y;
    };

    my ($val_y) = $val_x->interpolate( PDL->pdl(@x), PDL->pdl(@y) );
    return $val_y;
}

# Some functions are not marked private (using leading '_')
# but should be used by AI::FuzzyEngine::Variable only:

sub set_x_limits {
    my ($class, $fun, $from, $to) = @_;

    my @x = _x_of $fun;
    my @y = _y_of $fun;