AI-FuzzyEngine
view release on metacpan or search on metacpan
Tests re-factored
requires perl 5.8.9
POD improved, PDL sections added
0.2.1 2013-02-14
Bug in test fixed (use PDL removed)
versioning of Set and Variable adapted
0.2.2 2013-02-27
Declaring a version with version->declare() instead of qw()
A variable can change its sets' membership functions
(e.g. within optimisation routines)
Providing $fe->true() and $fe->false()
AI-FuzzyEngine v0.2.2
This module is yet another implementation of a fuzzy inference system.
The aim was to be able to code rules (no string parsing),
but avoid operator overloading,
and make it possible to split calculation into multiple steps.
All intermediate results (memberships of sets of variables)
should be available.
Beginning with v0.2.0 it is PDL aware,
meaning that it can handle piddles (PDL objects)
when running the fuzzy operations.
More information on PDL can be found at L<http://pdl.perl.org/>.
Credits to Ala Qumsieh and his L<AI::FuzzyInference>,
that showed me that fuzzy is no magic.
I learned a lot by analyzing his code,
lib/AI/FuzzyEngine.pm view on Meta::CPAN
sub new_variable {
my ($self, @pars) = @_;
my $variable_class = $self->_class_of_variable();
my $var = $variable_class->new($self, @pars);
push @{$self->{_variables}}, $var;
Scalar::Util::weaken $self->{_variables}->[-1];
return $var;
}
sub reset {
my ($self) = @_;
$_->reset() for $self->variables();
return $self;
}
sub _class_of_variable { 'AI::FuzzyEngine::Variable' }
sub _non_is_a_piddle {
return List::MoreUtils::none {ref $_ eq 'PDL'} @_;
}
my $_PDL_is_imported;
lib/AI/FuzzyEngine.pm view on Meta::CPAN
# Conjunction:
my $b = $fe->and( 0.2, 0.5, 0.8, 0.7 ); # 0.2
# Negation:
my $c = $fe->not( 0.4 ); # 0.6
# Always true:
my $t = $fe->true(); # 1.0
# Always false:
my $f = $fe->false(); # 0.0
# These functions are constitutive for the operations
# on the fuzzy sets of the fuzzy variables:
# VARIABLES (AI::FuzzyEngine::Variable)
# input variables need definition of membership functions of their sets
my $flow = $fe->new_variable( 0 => 2000,
small => [0, 1, 500, 1, 1000, 0 ],
med => [ 400, 0, 1000, 1, 1500, 0 ],
huge => [ 1000, 0, 1500, 1, 2000, 1],
);
my $cap = $fe->new_variable( 0 => 1800,
avg => [0, 1, 1500, 1, 1700, 0 ],
high => [ 1500, 0, 1700, 1, 1800, 1],
);
# internal variables need sets, but no membership functions
my $saturation = $fe->new_variable( # from => to may be ommitted
low => [],
crit => [],
over => [],
);
# But output variables need membership functions for their sets:
my $green = $fe->new_variable( -5 => 5,
decrease => [-5, 1, -2, 1, 0, 0 ],
ok => [ -2, 0 0, 1, 2, 0 ],
increase => [ 0, 0, 2, 1, 5, 1],
);
# Reset FuzzyEngine (resets all variables)
$fe->reset();
# Reset a fuzzy variable directly
$flow->reset;
# Membership functions can be changed via the set's variable.
# This might be useful during parameter identification algorithms
# Changing a function resets the respective variable.
$flow->change_set( med => [500, 0, 1000, 1, 1500, 0] );
# Fuzzification of input variables
$flow->fuzzify( 600 );
$cap->fuzzify( 1000 );
# Membership degrees of the respective sets are now available:
my $flow_is_small = $flow->small(); # 0.8
my $flow_is_med = $flow->med(); # 0.2
my $flow_is_huge = $flow->huge(); # 0.0
# RULES and their application
# a) If necessary, calculate some internal variables first.
# They will not be defuzzified (in fact, $saturation can't)
# Implicit application of 'and'
# Multiple calls to a membership function
lib/AI/FuzzyEngine.pm view on Meta::CPAN
$flow->huge(),
$cap->high(),
);
$saturation->over( $flow->huge(), $fe->not( $cap->high() ) );
# b) deduce output variable(s) (here: from internal variable $saturation)
$green->decrease( $saturation->low() );
$green->ok( $saturation->crit() );
$green->increase( $saturation->over() );
# All sets provide their respective membership degrees:
my $saturation_is_over = $saturation->over(); # This is no defuzzification!
my $green_is_ok = $green->ok();
# Defuzzification ( is a matter of the fuzzy variable )
my $delta_green = $green->defuzzify(); # -5 ... 5
=head2 Using PDL and its threading capability
use PDL;
use AI::FuzzyEngine;
lib/AI/FuzzyEngine.pm view on Meta::CPAN
print 'Threshold is low: ', $threshold->low(), "\n";
# [
# [0.33333333]
# [ 1]
# ]
# Apply some rules
$problem->yes( $severity->high, $threshold->low );
$problem->no( $fe->not( $problem->yes ) );
# Fuzzy results are represented by the membership degrees of sets
print 'Problem yes: ', $problem->yes, "\n";
# [
# [ 0 0.33333333 0.33333333 0.33333333]
# [ 0 0.5 1 1]
# ]
# Defuzzify the output variables
# Caveat: This includes some non-threadable operations up to now
my $problem_ratings = $problem->defuzzify();
print 'Problems rated: ', $problem_ratings;
lib/AI/FuzzyEngine.pm view on Meta::CPAN
=head1 EXPORT
Nothing is exported or exportable.
=head1 DESCRIPTION
This module is yet another implementation of a fuzzy inference system.
The aim was to be able to code rules (no string parsing),
but avoid operator overloading,
and make it possible to split calculation into multiple steps.
All intermediate results (memberships of sets of variables)
should be available.
Beginning with v0.2.0 it is PDL aware,
meaning that it can handle piddles (PDL objects)
when running the fuzzy operations.
More information on PDL can be found at L<http://pdl.perl.org/>.
Credits to Ala Qumsieh and his L<AI::FuzzyInference>,
that showed me that fuzzy is no magic.
I learned a lot by analyzing his code,
and he provides good information and links to learn more about Fuzzy Logics.
=head2 Fuzzy stuff
The L<AI::FuzzyEngine> object defines and provides
the elementary operations for fuzzy sets.
All membership degrees of sets are values from 0 to 1.
Up to now there is no choice with regard to how to operate on sets:
=over 2
=item C<< $fe->or( ... ) >> (Disjunction)
is I<Maximum> of membership degrees
=item C<< $fe->and( ... ) >> (Conjunction)
is I<Minimum> of membership degrees
=item C<< $fe->not( $var->$set ) >> (Negation)
is I<1-degree> of membership degree
=item Aggregation of rules (Disjunction)
is I<Maximum>
=item True C<< $fe->true() >> and false C<< $fe->false() >>
are provided for convenience.
=back
Defuzzification is based on
=over 2
=item Implication
I<Clip> membership function of a set according to membership degree,
before the implicated memberships of all sets of a variable are taken for defuzzification:
=item Defuzzification
I<Centroid> of aggregated (and clipped) membership functions
=back
=head2 Public functions
Creation of an C<AI::FuzzyEngine> object by
lib/AI/FuzzyEngine.pm view on Meta::CPAN
my $fe = AI::FuzzyEngine->new();
This function has no parameters. It provides the fuzzy methods
C<or>, C<and> and C<not>, as listed above.
If needed, I will introduce alternative fuzzy operations,
they will be configured as arguments to C<new>.
Once built, the engine can create fuzzy variables by C<new_variable>:
my $var = $fe->new_variable( $from => $to,
$name_of_set1 => [$x11, $y11, $x12, $y12, ... ],
$name_of_set2 => [$x21, $y21, $x22, $y22, ... ],
...
);
Result is an L<AI::FuzzyEngine::Variable>.
The name_of_set strings are taken to assign corresponding methods
for the respective fuzzy variables.
They must be valid function identifiers.
Same name_of_set can used for different variables without conflict.
Take care:
There is no check for conflicts with predefined class methods.
Fuzzy variables provide a method to fuzzify input values:
$var->fuzzify( $val );
according to the defined sets and their membership functions.
The memberships of the sets of C<$var> are accessible
by the respective functions:
my $membership_degree = $var->$name_of_set();
Membership degrees can be assigned directly (within rules for example):
$var->$name_of_set( $membership_degree );
If multiple membership_degrees are given, they are "anded":
$var->$name_of_set( $degree1, $degree2, ... ); # "and"
By this, simple rules can be coded directly:
my $var_3->zzz( $var_1->xxx, $var_2->yyy, ... ); # "and"
this implements the fuzzy implication
if $var_1->xxx and $var_2->yyy and ... then $var_3->zzz
The membership degrees of a variable's sets can be reset to undef:
$var->reset(); # resets a variable
$fe->reset(); # resets all variables
The fuzzy engine C<$fe> has all variables registered
that have been created by its C<new_variable> method.
A variable can be defuzzified:
my $out_value = $var->defuzzify();
Membership functions can be replaced via a set's variable:
$var->change_set( $name_of_set => [$x11n, $y11n, $x12n, $y12n, ... ] );
The variable will be reset when replacing a membership function
of any of its sets.
Interdependencies with other variables are not checked
(it might happen that the results of any rules are no longer valid,
so it needs some recalculations).
Sometimes internal variables are used that need neither fuzzification
nor defuzzification.
They can be created by a simplified call to C<new_variable>:
my $var_int = $fe->new_variable( $name_of_set1 => [],
$name_of_set2 => [],
...
);
Hence, they can not use the methods C<fuzzify> or C<defuzzify>.
Fuzzy operations are simple operations on floating values between 0 and 1:
my $conjunction = $fe->and( $var1->xxx, $var2->yyy, ... );
my $disjunction = $fe->or( $var1->xxx, $var2->yyy, ... );
my $negated = $fe->not( $var1->zzz );
There is no magic.
A sequence of rules for the same set can be implemented as follows:
$var_3->zzz( $var_1->xxx, $var_2->yyy, ... );
$var_3->zzz( $var_4->aaa, $var_5->bbb, ... );
The subsequent application of C<< $var_3->zzz(...) >>
corresponds to "or" operations (aggregation of rules).
Only a reset can reset C<$var_3>.
=head2 PDL awareness
Membership degrees of sets might be either scalars or piddles now.
$var_a->memb_fun_a( 5 ); # degree of memb_fun_a is a scalar
$var_a->memb_fun_b( pdl(7, 8) ); # degree of memb_fun_b is a piddle
Empty piddles are not allowed, behaviour with bad values is not tested.
Fuzzification (hence calculating degrees) accepts piddles:
$var_b->fuzzify( pdl([1, 2], [3, 4]) );
Defuzzification returns a piddle if any of the membership
degrees of the function's sets is a piddle:
my $val = $var_a->defuzzify(); # $var_a returns a 1dim piddle with two elements
So do the fuzzy operations as provided by the fuzzy engine C<$fe> itself.
Any operation on more then one piddle expands those to common
dimensions, if possible, or throws a PDL error otherwise.
The way expansion is done is best explained by code
(see C<< AI::FuzzyEngine->_cat_array_of_piddles(@pdls) >>).
lib/AI/FuzzyEngine/Set.pm view on Meta::CPAN
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;
return $fun unless @x;
if (@x == 1) {
# Explicitly deal with this case to allow recursive removing of points
$fun->[0] = [$from => $to];
lib/AI/FuzzyEngine/Set.pm view on Meta::CPAN
unshift @x, $from;
unshift @y, $y[0];
}
elsif ($x[0] < $from) {
# Check for @x > 1 allows to use $x[1]
if ($x[1] <= $from) {
# Recursive call with removed left border
shift @{$fun->[0]};
shift @{$fun->[1]};
$class->set_x_limits( $fun, $from => $to );
# update @x and @y for further calculation
@x = _x_of $fun;
@y = _y_of $fun;
}
else {
$x[0] = $from;
$y[0] = $class->_interpol( $fun => $from );
};
lib/AI/FuzzyEngine/Set.pm view on Meta::CPAN
push @x, $to;
push @y, $y[-1];
}
elsif ($x[-1] > $to) {
# Check for @x > 1 allows to use $x[-2]
if ($x[-2] >= $to) {
# Recursive call with removed right border
pop @{$fun->[0]};
pop @{$fun->[1]};
$class->set_x_limits( $fun, $from => $to );
# update @x and @y for further calculation
@x = _x_of $fun;
@y = _y_of $fun;
}
else {
$x[-1] = $to;
$y[-1] = $class->_interpol( $fun => $to );
};
lib/AI/FuzzyEngine/Set.pm view on Meta::CPAN
sub fuzzify {
my ($self, $val) = @_;
my $fun = $self->memb_fun;
croak "No valid membership function"
unless @{$fun->[0]}; # at least one x
return $self->{degree} = $self->_interpol( $fun => $val );
}
sub reset {
my ($self) = @_;
$self->{degree} = 0;
$self;
}
# Replace a membership function
# To be called by variable->change_set( 'setname' => $new_fun );
sub replace_memb_fun {
my ($self, $new_fun) = @_;
$self->{memb_fun} = $new_fun;
return;
}
1;
=pod
lib/AI/FuzzyEngine/Variable.pm view on Meta::CPAN
use version 0.77; our $VERSION = version->declare('v0.2.2');
use strict;
use warnings;
use Scalar::Util qw( blessed looks_like_number );
use List::MoreUtils;
use Carp;
use AI::FuzzyEngine::Set;
my $set_class = _class_of_set();
sub new {
my ($class, $fuzzyEngine, @pars) = @_;
my $self = bless {}, $class;
# check and store the assigned fuzzyEngine
my $fe_class = 'AI::FuzzyEngine';
croak "fuzzyEngine is not a $fe_class"
unless blessed $fuzzyEngine && $fuzzyEngine->isa($fe_class);
$self->{fuzzyEngine} = $fuzzyEngine;
# load pars, create sets etc.
$self->_init(@pars);
return $self;
};
sub is_internal { shift->{is_internal} }
sub from { shift->{from} };
sub to { shift->{to} };
sub sets { shift->{sets} };
sub set_names { @{shift->{set_names}} };
sub set {
my ($self, $set_name) = @_;
return $self->{sets}{$set_name};
};
sub fuzzyEngine { shift->{fuzzyEngine} };
sub is_valid_set {
my ($self, $set_name) = @_;
# Should be simplified to exists $self->{sets}{$set_name}
return List::MoreUtils::any { $_ eq $set_name } keys %{ $self->sets };
}
sub fuzzify {
my ($self, $val) = @_;
croak "Fuzzification not allowed for internal variables"
if $self->is_internal;
for my $set (values %{ $self->sets } ) {
$set->fuzzify( $val );
};
return;
}
sub defuzzify {
my ($self) = @_;
croak "Defuzzification not allowed for internal variables"
if $self->is_internal;
my @sets = values %{$self->sets};
my @funs = map { $_->memb_fun } @sets;
my @degrees = map { $_->degree } @sets;
# If all degrees are real scalars a shortcut is possible
if (_non_is_a_piddle(@degrees)) {
my $funs = _clipped_funs( \@funs, \@degrees);
my $fun_agg = $set_class->max_of_funs( @$funs );
my $c = $set_class->centroid( $fun_agg );
return $c;
};
# Need a function of my FuzzyEngine
my $fe = $self->fuzzyEngine;
die 'Internal: fuzzy_engine is lost' unless $fe;
# Unify dimensions of all @degrees (at least one is a pdl)
my @synched_degrees = $fe->_cat_array_of_piddles(@degrees)->dog;
my @dims_to_reshape = $synched_degrees[0]->dims;
# Make degrees flat to proceed them as lists
my @flat_degrees = map {$_->flat} @synched_degrees;
my $flat_degrees = PDL::cat( @flat_degrees );
# Proceed degrees of @sets as synchronized lists
my @degrees_per_el = $flat_degrees->transpose->dog;
my @defuzzified;
for my $ix (reverse 0..$#degrees_per_el) {
my $el_degrees = $degrees_per_el[$ix];
# The next two lines cost much (75% of defuzzify)
my $funs = _clipped_funs( \@funs, [$el_degrees->list] );
my $fun_agg = $set_class->max_of_funs( @$funs );
my $c = $set_class->centroid( $fun_agg );
$defuzzified[$ix] = $c;
};
# Build result in shape of unified membership degrees
my $flat_defuzzified = PDL->pdl( @defuzzified );
my $defuzzified = $flat_defuzzified->reshape(@dims_to_reshape);
return $defuzzified;
}
sub _clipped_funs {
# Clip all membership functions of a variable
# according to the respective membership degree (array of scalar)
my ($funs, $degrees) = @_;
my @funs = @$funs; # Dereferencing here saves some time
my @degrees = @$degrees;
my @clipped = List::MoreUtils::pairwise {
$set_class->clip_fun($a => $b)
} @funs, @degrees;
return \@clipped;
}
sub reset {
my ($self) = @_;
$_->reset() for values %{$self->sets};
return $self;
}
sub change_set {
my ($self, $setname, $new_memb_fun) = @_;
my $set = $self->set( $setname );
# Some checks
croak "Set $setname does not exist" unless defined $set;
croak 'Variable is internal' if $self->is_internal;
# Convert to internal representation
my $fun = $self->_curve_to_fun( $new_memb_fun );
# clip membership function to borders
$set->set_x_limits( $fun, $self->from => $self->to );
# Hand the new function over to the set
$set->replace_memb_fun( $fun );
# and reset the variable
$self->reset;
return;
}
sub _init {
my ($self, @pars) = @_;
croak "Too few arguments" unless @pars >= 2;
# Test for internal variable
my ($from, $to, @sets);
if (looks_like_number $pars[0]) {
# $from => $to is given
$self->{is_internal} = '';
($from, $to, @sets) = @pars;
}
else {
$self->{is_internal} = 1;
($from, $to, @sets) = (undef, undef, @pars);
};
# Store $from, $to ( undef if is_internal)
$self->{from} = $from;
$self->{to } = $to;
# Provide names of sets in correct order by attribute set_names
my $ix = 1;
$self->{set_names} = [ grep {$ix++ % 2} @sets ];
# Build sets of the variable
my %sets = @sets;
SET_TO_BUILD:
for my $set_name (keys %sets) {
my $fun = [ [] => [] ]; # default membership function
if (not $self->is_internal) {
# Convert from set of points to [ \@x, \@y ] format
my $curve = $sets{$set_name};
$fun = $self->_curve_to_fun( $curve );
# clip membership function to borders
$set_class->set_x_limits( $fun, $self->from => $self->to );
};
# create a set and store it
my $set_class = $self->_class_of_set();
my $set = $set_class
->new( fuzzyEngine => $self->fuzzyEngine,
variable => $self,
name => $set_name,
memb_fun => $fun, # [ [] => [] ] if is_internal
);
$self->{sets}{$set_name} = $set;
# build membership function if necessary
next SET_TO_BUILD if $self->can( $set_name );
my $method = sub {
my ($variable, @vals) = @_; # Variable, fuzzy values
my $set = $variable->{sets}{$set_name};
return $set->degree( @vals );
};
# register the new method to $self (the fuzzy variable)
no strict 'refs';
*{ $set_name } = $method;
};
}
sub _non_is_a_piddle {
return List::MoreUtils::none {ref $_ eq 'PDL'} @_;
}
# Might change for Variables inherited from AI::FuzzyEngine::Variable:
sub _class_of_set { 'AI::FuzzyEngine::Set' }
sub _curve_to_fun {
# Convert input format for membership functions
# to internal representation:
# [$x11, $y11, $x12, $y12, ... ]
# --> [ $x11, $x12, ... ] => [$y11, $y12, ... ] ]
my ($class, $curve) = @_;
my %points = @$curve;
my @x = sort {$a<=>$b} keys %points;
my @y = @points{ @x };
t/01-fuzzyEngine.t view on Meta::CPAN
use Test::Most;
use List::MoreUtils;
# check (not-) loading of PDL
BEGIN { use_ok 'AI::FuzzyEngine::Set' };
BEGIN { use_ok 'AI::FuzzyEngine::Variable' };
BEGIN { use_ok 'AI::FuzzyEngine' };
sub class { 'AI::FuzzyEngine' };
sub set_class { 'AI::FuzzyEngine::Set' };
sub var_class { 'AI::FuzzyEngine::Variable' };
my $class = class();
my $engine_class = class();
my $set_class = set_class();
my $var_class = var_class();
my $PDL_is_loaded = exists $INC{PDL};
subtest "$class constructor" => sub {
can_ok $class, 'new';
ok my $fe = $class->new, $class . '->new succeeds';
isa_ok $fe, $class, 'What it returns';
};
t/01-fuzzyEngine.t view on Meta::CPAN
# True:
my $t = $fe->true();
is( $t, 1.0, '"true"' );
# False:
my $f = $fe->false();
is( $f, 0.0, '"false"' );
};
subtest "Class $set_class _copy_fun" => sub {
my $fun_in = [[1=>2] => [-1=>1]];
my $fun_out = $set_class->_copy_fun( $fun_in );
ok( ( $fun_out ne $fun_in )
&& ($fun_out->[0] ne $fun_in->[0])
&& ($fun_out->[1] ne $fun_in->[1]),
'_copy_fun copies all references',
);
my $fun = [ [10] => [0.5] ];
$set_class->set_x_limits( $fun, 0 => 1 );
is_deeply( $fun,
[ [0, 1] => [0.5, 0.5] ],
'set_x_limits, single point',
);
$fun = [ [1, 2] => [1, 1] ];
$set_class->set_x_limits( $fun, 0 => 3 );
is_deeply( $fun,
[ [0, 1, 2, 3] => [1, 1, 1, 1] ],
'set_x_limits, enlarge',
);
};
subtest "Class $set_class set_x_limits" => sub {
my $fun = [ [-1, 4] => [1, 1] ];
$set_class->set_x_limits( $fun, 0 => 3 );
is_deeply( $fun,
[ [0, 3] => [1, 1] ],
'set_x_limits, reduce',
);
$fun = [ [-0.4, -0.2, 1.2, 1.4] => [0, 1, 1, 0] ];
$set_class->set_x_limits( $fun, -0.2 => 1.2 );
is_deeply( $fun,
[ [-0.2, 1.2] => [1, 1] ],
'set_x_limits, meet inner points',
);
$fun = [ [-1.2, -1.0, 1.2, 1.4] => [0, 1, 1, 0] ];
$set_class->set_x_limits( $fun, -0.2 => 0.2 );
is_deeply( $fun,
[ [-0.2, 0.2] => [1, 1] ],
'set_x_limits skip inner points',
);
};
subtest "Class $set_class synchronize_funs" => sub {
my $funA = [ [1, 2] => [-1, -2] ];
my $funB = [ [0, 4] => [-2, -3] ];
$set_class->synchronize_funs( $funA, $funB );
is_deeply( $funA->[0], [0, 1, 2, 4], 'synchronize_funs $funA->x' );
is_deeply( $funB->[0], [0, 1, 2, 4], 'synchronize_funs $funB->x' );
# y: borders not clipped, so interpol uses border values directly
is_deeply( $funA->[1], [-1, -1, -2, -2],
'synchronize_funs $funA->y',
);
is_deeply( $funB->[1], [-2, -2.25, -2.5, -3],
'synchronize_funs $funB->y',
);
# crossing
$funA = [ [0, 1] => [0.5, 2] ];
$funB = [ [0, 1] => [ 2, 1.5] ];
$set_class->synchronize_funs( $funA, $funB );
is_deeply( $funA,
[ [0, 0.75, 1] => [0.5, 1.625, 2] ],
'synchronize_funs $funA with crossing curves',
);
is_deeply( $funB,
[ [0, 0.75, 1] => [2, 1.625, 1.5] ],
'synchronize_funs $funB with crossing curves',
);
$funA = [ [] => [] ];
$funB = [ [] => [] ];
throws_ok { $set_class->synchronize_funs( $funA, $funB )
} qr/is empty/, 'Checks for empty functions';
};
subtest "Class $set_class min & max" => sub {
my $funA = [ [1, 2] => [-1, -2] ];
my $funB = [ [0, 4] => [-2, -3] ];
is_deeply( $set_class->min_of_funs( $funA, $funB ),
[ [0, 1, 2, 4] => [-2, -2.25, -2.5, -3] ],
'min_of_funs',
);
is_deeply( $set_class->max_of_funs( $funA, $funB ),
[ [0, 1, 2, 4] => [-1, -1, -2, -2] ],
'max_of_funs',
);
my $funC = [ [0, 4] => [-2.75, -2.75] ];
is_deeply( $set_class->min_of_funs( $funA, $funB, $funC ),
[ [0, 1, 2, 3, 4] => [-2.75, -2.75, -2.75, -2.75, -3] ],
'min_of_funs recursively',
);
};
subtest "Class $set_class clip_fun, centroid" => sub {
my $funA = [ [0, 1, 2] => [0, 1, 0] ];
my $funA_clipped = $set_class->clip_fun( $funA => 0.5 );
is_deeply( $funA_clipped,
[ [0, 0.5, 1, 1.5, 2] => [0, 0.5, 0.5, 0.5, 0] ],
'clip_fun',
);
my $fun = [ [1, 2] => [1, 1] ];
my $c = $set_class->centroid( $fun );
is( $c, 1.5, 'centroid box' );
$fun = [ [1, 4] => [0, 1] ];
$c = $set_class->centroid( $fun );
is( $c, 3, 'centroid triangle positive slope' );
$fun = [ [1, 4] => [1, 0] ];
$c = $set_class->centroid( $fun );
is( $c, 2, 'centroid triangle positive slope' );
$fun = [ [-2, 0, 0, 3] => [0.75, 0.75, 1, 0] ];
$c = $set_class->centroid( $fun );
is( $c, 0, 'centroid combination, checking area calculation' );
};
my $fe = a_fuzzyEngine();
my %set_pars = ( fuzzyEngine => $fe,
variable => a_variable( $fe ),
name => 'few',
memb_fun => [[7, 8] => [0, 1]],
);
subtest "$set_class constructor" => sub {
my $s = $set_class->new(%set_pars);
isa_ok( $s, $set_class, 'What the constructor returns' );
is_deeply( [ $s->name, $s->memb_fun, $s->variable, $s->fuzzyEngine],
[@set_pars{qw(name memb_fun variable)}, $fe],
'Attributes given in the constructor',
);
};
subtest "$set_class methods" => sub {
my $s = $set_class->new(%set_pars);
is( $s->degree, 0, 'Initial (internal) membership degree is 0' );
$s->degree( 0.2 );
is( $s->degree, 0.2, 'degree can be set by assignment' );
$s->degree( 0.1 );
is( $s->degree, 0.2, 'Disjunction of last and new degree' );
$s->degree( 0.3, 0.5 );
is( $s->degree, 0.3, 'Conjunction of multiple inputs ("and" operation)' );
local $set_pars{memb_fun} = [ [0.2, 0.3, 0.8, 1.0], # x
[0.1, 0.5, 0.5, 0.0], # y
];
$s = $set_class->new(%set_pars);
# fuzzify some values
my @vals = ( 0, 0.2, 0.25, 0.3, 0.5, 0.8, 0.90, 1);
my @expected = (0.1, 0.1, 0.30, 0.5, 0.5, 0.5, 0.25, 0 );
my @got = map { $s->fuzzify($_) } @vals;
is_deeply( \@got, \@expected,
'fuzzify incl. corner cases and reset of degree',
);
my $degree = $s->fuzzify( 0.2 );
is( $degree, 0.1, 'fuzzify returns degree' );
$set_pars{memb_fun} = [ [0, 1, 1, 2] => [1, 2, 3, 4] ];
throws_ok {$s = AI::FuzzyEngine::Set->new(%set_pars)
} qr/no double/i, 'Checks double interpolation coordinates';
};
subtest "$set_class special memb_fun methods" => sub {
# Replace a membership function
my $s = $set_class->new(%set_pars);
is_deeply( $s->memb_fun, [[7, 8] => [0, 1]],
'(preconditions)',
) or diag 'Test broken, check precondition';
my $new_fun = [ [5, 6] => [0.5, 0.7] ];
$s->replace_memb_fun( $new_fun );
is_deeply( $s->memb_fun, $new_fun, 'replace_memb_fun' );
1;
};
t/01-fuzzyEngine.t view on Meta::CPAN
);
subtest "$var_class constructor" => sub {
my $v = $var_class->new( $fe, @var_pars );
isa_ok( $v, $var_class, '$v' );
is( $v->fuzzyEngine, $fe, 'fuzzyEngine is stored' );
ok( ! $v->is_internal, 'Variable is not internal' );
is_deeply( [$v->from, $v->to, [ sort keys %{ $v->sets } ] ],
[ 0, 10, [ sort qw(low high) ] ],
'Variable attributes and set names',
);
};
subtest "$var_class methods" => sub {
my $v = $var_class->new( $fe, @var_pars );
ok( $v->is_valid_set('high' ), 'is_valid_set (true) ' );
ok( ! $v->is_valid_set('wrong_set'), 'is_valid_set (false)' );
};
subtest "$var_class generated sets" => sub {
my $v = $var_class->new( $fe, @var_pars );
my $low_set = $v->sets->{low};
isa_ok( $low_set, $set_class, 'What variable generates' );
is_deeply( $low_set->memb_fun,
[ [0, 10] => [1, 0] ],
'and receives converted membership functions',
);
can_ok( $v, 'low' ); # can_ok needs no description!
my $degree = $v->low;
is( $degree, 0, 'initial value for degree of low' );
$degree = $v->low(0.2, 0.1);
t/01-fuzzyEngine.t view on Meta::CPAN
'low' => [0, 1],
'med' => [0, 0],
);
# $v and $w have a 'low' function.
# Are they independent with regard to degree?
is( $v->low, 0.1, 'degree for low unchanged from other variables' );
is( $w->low, 0, 'degree for low of the new variable is independent');
};
subtest "$var_class order of sets" => sub {
my @range = 0..99;
my @list_of_sets = map { ("s_$_" => [$_,1]) } @range;
my $x = $var_class->new( $fe, 0 => 1, @list_of_sets );
my @indexes = map {/(\d+)/} $x->set_names;
no warnings qw(once);
my @is_same = List::MoreUtils::pairwise {$a==$b} @range, @indexes;
ok( ( List::MoreUtils::all {$_} @is_same ),
q{set_names returns the set's names in correct range},
);
};
subtest "$var_class completing membership functions in x" => sub {
my $v = $var_class->new( $fe,
0 => 10,
'low' => [ 3, 1, 6, 0],
'med' => [ 5, 0.5],
'high' => [ -5, 0, 15, 1],
);
is_deeply( $v->sets->{low}->memb_fun(),
[ [0, 3, 6, 10] => [1, 1, 0, 0] ],
'borders of membership funs are adapted to from=>to',
);
is_deeply( $v->sets->{med}->memb_fun(),
[ [0, 10] => [0.5, 0.5] ],
'even if constant',
);
is_deeply( $v->sets->{high}->memb_fun(),
[ [0, 10] => [0.25, 0.75] ],
'... limits even when crossing edges',
);
};
subtest "$var_class change_set" => sub {
my $v = $var_class->new( $fe,
0 => 10,
'low' => [ 3, 1, 6, 0],
# becomes [ [0, 3, 6, 10] => [1, 1, 0, 0] ],
'high' => [ -5, 0, 15, 1],
);
$v->fuzzify( 5 ); # $v->low > 0 && $v->high > 0
my $new_memb_fun = [2, 1, 8, 0];
$v->change_set( low => $new_memb_fun );
is_deeply( $v->sets->{low}->memb_fun(),
[ [0, 2, 8, 10] => [1, 1, 0, 0] ],
'change_set works and adapts borders in x',
);
is_deeply( [$v->low, $v->high], [0, 0], 'change_set resets the variable' );
throws_ok { $v->change_set( 'wrong_set' )
} qr/set/i, 'change_set checks correct set name';
1;
};
subtest "$var_class fuzzification and defuzzification" => sub {
my $v = $var_class->new( $fe,
0 => 10,
'low' => [ 3, 1, 6, 0],
'med' => [ 5, 0.5],
'high' => [ -5, 0, 15, 1],
);
$v->fuzzify( 0 );
is_deeply( [$v->low, $v->med, $v->high],
[ 1, 0.5, 0.25],
'fuzzify fuzzifies all sets',
);
$v->fuzzify( 10 );
is_deeply( [$v->low, $v->med, $v->high],
[ 0, 0.5, 0.75],
'fuzzify resets and fuzzifies all sets',
);
# Defuzzification
$v = AI::FuzzyEngine::Variable
->new( $fe,
0 => 2,
low => [0 => 1, 1 => 1, 1.00001 => 0, 2 => 0],
high => [0 => 0, 1 => 0, 1.00001 => 1, 2 => 1],
);
$v->low( 1 ); # explicit control for next tests
$v->high( 0 );
my $val = sprintf "%.2f", $v->defuzzify();
is( $val*1, 0.5, 'defuzzy low' );
$v->reset;
$v->low( 0 );
$v->high( 0.5 );
$val = sprintf "%.2f", $v->defuzzify();
is( $val*1, 1.5, 'defuzzy high' );
$v->low( 1 );
$val = $v->defuzzify();
ok( ($val > 0.5 && $val < 1), 'defuzzy low + 0.5*high' );
};
t/01-fuzzyEngine.t view on Meta::CPAN
'high' => [0, 0, 10, 1],
);
subtest "$var_class (internal) constructor" => sub {
my $v = $var_class->new( $fe, @int_var_pars );
isa_ok( $v, $var_class, '$v' );
is( $v->fuzzyEngine, $fe, 'fuzzyEngine is stored' );
ok( $v->is_internal, 'Variable is internal' );
is( ref( $v->sets), 'HASH', 'sets is a HashRef' );
is_deeply( [$v->from, $v->to, [ sort keys %{ $v->sets } ] ],
[ undef, undef, [ sort qw(low high) ] ],
'Variable attributes and set names',
);
};
subtest "$var_class (internal) methods" => sub {
my $v = $var_class->new( $fe, @int_var_pars );
ok( $v->is_valid_set('high' ), 'is_valid_set (true) ' );
ok( ! $v->is_valid_set('wrong_set'), 'is_valid_set (false)' );
my $low_set = $v->set('low');
isa_ok( $low_set, $set_class, 'What variable->set returns' );
is_deeply( $low_set->memb_fun,
[[]=>[]],
'Membership function is empty',
);
can_ok( $v, 'low' );
my $degree = $v->low;
is( $degree, 0, 'initial value for degree of low' );
$degree = $v->low(0.2, 0.1);
is( $degree, 0.1, 'and / or for degree of low work' );
$v->reset;
is( $v->low, 0, 'reset works' );
# Throw errors!
throws_ok { $v->fuzzify(0)
} qr/internal/, 'Checks illegal fuzzify call';
throws_ok { $v->defuzzify
} qr/internal/, 'Checks illegal defuzzify call';
throws_ok { $v->change_set( low => [[]=>[]] )
} qr/internal/i, 'Blocks change_set';
};
$fe = $class->new();
subtest "$class as factory" => sub {
my $v = $fe->new_variable( 0 => 10,
'low' => [0, 1, 10, 0],
'high' => [0, 0, 10, 1],
);
isa_ok( $v, $var_class, 'What $fe->new_variable returns' );
is_deeply( [$v->from, $v->to, [ sort keys %{ $v->sets } ] ],
[ 0, 10, [ sort qw(low high) ] ],
'Variable attributes and set names by new_variable',
);
my $w = $fe->new_variable( 0 => 1,
'low' => [0, 1],
'high' => [1, 0],
);
is_deeply( [ $fe->variables() ],
[$v, $w],
'Engine stores variables (should be weakened)',
);
$v->low( 0.1 );
$w->low( 0.2 );
my $v_resetted = $v->reset;
isa_ok( $v_resetted,
$var_class,
'What variable->reset returns',
) or exit;
is( $v->low, 0.0, 'Variable can be resetted' );
is( $w->low, 0.2, 'Other variables stay unchanged' );
my $fe_resetted = $fe->reset();
isa_ok( $fe_resetted,
$class,
'What fuzzyEngine->reset returns',
);
is( $w->low, 0.0, 'FuzzyEngine resets all variables' );
};
subtest 'synopsis' => sub {
# Engine (or factory) provides fuzzy logical arithmetic
my $fe = $class->new();
# Disjunction:
my $a = $fe->or ( 0.2, 0.5, 0.8, 0.7 ); # 0.8
# Conjunction:
my $b = $fe->and( 0.2, 0.5, 0.8, 0.7 ); # 0.2
# Negation:
my $c = $fe->not( 0.4 ); # 0.6
# Always true:
my $t = $fe->true(); # 1.0
# Always false:
my $f = $fe->false(); # 0.0
# These functions are constitutive for the operations
# on the fuzzy sets of the fuzzy variables:
# VARIABLES (AI::FuzzyEngine::Variable)
# input variables need definition of membership functions of their sets
my $flow = $fe->new_variable( 0 => 2000,
small => [0, 1, 500, 1, 1000, 0 ],
med => [ 400, 0, 1000, 1, 1500, 0 ],
huge => [ 1000, 0, 1500, 1, 2000, 1],
);
my $cap = $fe->new_variable( 0 => 1800,
avg => [0, 1, 1500, 1, 1700, 0 ],
high => [ 1500, 0, 1700, 1, 1800, 1],
);
# internal variables need sets, but no membership functions
my $saturation = $fe->new_variable( # from => to may be ommitted
low => [],
crit => [],
over => [],
);
# But output variables need membership functions for their sets:
my $green = $fe->new_variable( -5 => 5,
decrease => [-5, 1, -2, 1, 0, 0 ],
ok => [ -2, 0, 0, 1, 2, 0 ],
increase => [ 0, 0, 2, 1, 5, 1],
);
# Reset FuzzyEngine (resets all variables)
$fe->reset();
# Reset a fuzzy variable directly
$flow->reset;
# Membership functions can be changed via the set's variable.
# This might be useful during parameter identification algorithms
# Changing a function resets the respective variable.
$flow->change_set( med => [500, 0, 1000, 1, 1500, 0] );
# Fuzzification of input variables
$flow->fuzzify( 600 );
$cap->fuzzify( 1000 );
# Membership degrees of the respective sets are now available:
my $flow_is_small = $flow->small(); # 0.8
my $flow_is_med = $flow->med(); # 0.2
my $flow_is_huge = $flow->huge(); # 0.0
# RULES and their application
# a) first step, result is $saturation, an intermediate set
# implicit application of 'and'
# Multiple calls to a membership function
# are similar to 'or' operations:
$saturation->low( $flow->small(), $cap->avg() );
$saturation->low( $flow->small(), $cap->high() );
$saturation->low( $flow->med(), $cap->high() );
# Explicite 'or', 'and' or 'not' possible:
$saturation->crit( $fe->or( $fe->and( $flow->med(), $cap->avg() ),
$fe->and( $flow->huge(), $cap->high() ),
t/01-fuzzyEngine.t view on Meta::CPAN
$flow->huge(),
$cap->high(),
);
$saturation->over( $flow->huge(), $fe->not( $cap->high() ) );
# b) second step, deduce output variable from internal state of saturation
$green->decrease( $saturation->low() );
$green->ok( $saturation->crit() );
$green->increase( $saturation->over() );
# All sets provide the respective membership degrees of their variables:
my $saturation_is_over = $saturation->over(); # no defuzzification!
my $green_is_ok = $green->ok();
# Defuzzification ( is a matter of the fuzzy set )
my $delta_green = $green->defuzzify(); # -5 ... 5
ok( 1, 'POD synopsis' );
};
subtest 'PDL may not be loaded' => sub {
if ($PDL_is_loaded) {
diag "PDL was loaded at start of test - check not possible";
}
else {
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
use Test::Most;
use List::MoreUtils;
use AI::FuzzyEngine::Set;
use AI::FuzzyEngine::Variable;
use AI::FuzzyEngine;
sub class { 'AI::FuzzyEngine' };
sub set_class { 'AI::FuzzyEngine::Set' };
sub var_class { 'AI::FuzzyEngine::Variable' };
my $class = class();
my $set_class = set_class();
my $var_class = var_class();
# Can PDL be loaded? skip_all if not.
my $module = 'PDL';
my $msg = qq{Cannot find $module. }
. qq{$class is not $module aware on your computer};
if (not eval "use $module; 1") { plan skip_all => $msg };
subtest "$class internal functions" => sub {
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
$c = $fe->or( 0.4, pdl( [0.5] ) );
isa_ok( $c, 'PDL', 'or(scalar, PDL)' );
ok_all( $c == 0.5, 'or(scalar, PDL): result' );
$c = $fe->or( 0.6, pdl( [0.5, 0.7] ) );
isa_ok( $c, 'PDL', 'or(scalar, 2elem PDL)' );
ok_all( $c == pdl([0.6, 0.7]), 'or(scalar, 2elem PDL): result' );
};
my $fe = a_fuzzyEngine();
my %set_pars = ( fuzzyEngine => $fe,
variable => a_variable( $fe ),
name => 'few',
memb_fun => [[7, 8] => [0, 1]],
);
subtest "$set_class PDL degree" => sub {
my $s = $set_class->new(%set_pars);
is( $s->degree, 0, 'Initial (internal) membership degree is 0' );
$s->degree( pdl(0.2) );
is( $s->degree, 0.2, 'degree can be set by assignment of a piddle' );
isa_ok( $s->degree, 'PDL', '$s->degree' );
$s->degree( 0.1 );
is( $s->degree, 0.2, 'Disjunction of last and new degree (1)' );
$s->degree( 0.3 );
is( $s->degree, 0.3, 'Disjunction of last and new degree (2)' );
isa_ok( $s->degree, 'PDL', '$s->degree after recalculation' );
$s->reset();
is( ref $s->degree, '', 'reset makes degree a scalar again' );
$s->degree( 0.3, pdl([0.5, 0.2]) );
ok_all( $s->degree == pdl([0.3, 0.2] ),
'Conjunction of multiple inputs ("and" operation)',
);
local $set_pars{memb_fun} = pdl( [[7, 8] => [0, 1]] );
throws_ok{ $set_class->new(%set_pars)
} qr/array ref/, 'Checks pureness of membership function';
};
subtest "$set_class PDL _interpol & fuzzify" => sub {
local $set_pars{memb_fun} = [ [0.2, 0.3, 0.8, 1.0], # x
[0.1, 0.5, 0.5, 0.0], # y
];
my $s = $set_class->new(%set_pars);
# fuzzify some values
# (no extrapolation in this test case)
my $x = pdl(0.2, 0.25, 0.3, 0.5, 0.8, 0.90, 1);
my $expected = pdl(0.1, 0.30, 0.5, 0.5, 0.5, 0.25, 0 );
my $got = $s->fuzzify( $x );
isa_ok( $got, 'PDL', 'What fuzzify (_interpol) returns' );
ok_all( $got == $expected, 'fuzzify' ) or diag $got;
};
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
);
$v->low( pdl(1, 0, 1) );
$v->high( 0.5 ); # non pdl
my $val = $v->defuzzify;
isa_ok( $val, 'PDL', 'What $v->defuzzify returns from scalar+pdl' );
my @size = $val->dims;
is_deeply( \@size, [3], 'dimensions' );
$v->reset;
$v->low( pdl(1, 0, 1) );
$v->high( pdl(0, 0.5, 0.5) );
my $val_got = $v->defuzzify;
my $val_exp = pdl( 0.5, 1.5, 0.83 );
ok_all( abs($val_got-$val_exp) < 0.1, 'defuzzify a piddle' );
# Performance: Run testfile by nytprofiler
$v->reset;
my $n =100;
$v->low( random($n) );
$v->high( 1-$v->low );
lives_ok { $val_got = $v->defuzzify; } "Defuzzifying $n elements";
};
subtest 'PDL synopsis' => sub {
# use PDL;
# use AI::FuzzyEngine;
( run in 0.551 second using v1.01-cache-2.11-cpan-49f99fa48dc )