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') {