AI-FuzzyEngine
view release on metacpan or search on metacpan
0.1.1 2013-02-08
README costumized. POD small improvement.
0.2.0 2013-02-13
PDL awareness
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()
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.
INSTALLATION
To install this module, run the following commands:
perl Build.PL
./Build
./Build test
./Build install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc AI::FuzzyEngine
LICENSE AND COPYRIGHT
lib/AI/FuzzyEngine.pm view on Meta::CPAN
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
lib/AI/FuzzyEngine.pm view on Meta::CPAN
=head2 Todos
=over 2
=item Add optional alternative implementations of fuzzy operations
=item More checks on input arguments and allowed method calls
=item PDL awareness: Use threading in C<< $variable->defuzzify >>
=item Divide tests into API tests and test of internal functions
=back
=head1 CAVEATS / BUGS
This is my first module.
I'm happy about feedback that helps me to learn
and improve my contributions to the Perl ecosystem.
Please report any bugs or feature requests to
t/00-load.t view on Meta::CPAN
use Test::More tests => 3;
BEGIN {
use_ok( 'AI::FuzzyEngine' ) || print "Bail out!\n";
use_ok( 'AI::FuzzyEngine::Variable' ) || print "Bail out!\n";
use_ok( 'AI::FuzzyEngine::Set' ) || print "Bail out!\n";
}
# diag( "Testing AI::FuzzyEngine $AI::FuzzyEngine::VERSION, Perl $], $^X" );
t/01-fuzzyEngine.t view on Meta::CPAN
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';
};
subtest "$class operations" => sub {
my $fe = $class->new();
# Disjunction:
my $a = $fe->or( 0.2, 0.5, 0.8, 0.7 );
is( $a, 0.8, '"or"' );
# Conjunction:
my $b = $fe->and( 0.2, 0.5, 0.8, 0.7 );
is( $b, 0.2, '"and"' );
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] ];
t/01-fuzzyEngine.t view on Meta::CPAN
);
$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 );
t/01-fuzzyEngine.t view on Meta::CPAN
);
$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',
);
t/01-fuzzyEngine.t view on Meta::CPAN
[ [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 );
t/01-fuzzyEngine.t view on Meta::CPAN
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' );
t/01-fuzzyEngine.t view on Meta::CPAN
);
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;
};
subtest "$var_class functions" => sub {
my $memb_fun = $var_class->_curve_to_fun( [8=>1, 7=>0] );
is_deeply( $memb_fun, [[7, 8] => [0, 1]], '_curve_to_fun' );
$memb_fun = $var_class->_curve_to_fun( [] );
is_deeply( $memb_fun, [[]=>[]], '_curve_to_fun( [] )' );
};
my @var_pars = ( 0 => 10, # order is relevant!
'low' => [0, 1, 10, 0],
'high' => [0, 0, 10, 1],
);
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!
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] ],
t/01-fuzzyEngine.t view on Meta::CPAN
[ [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];
t/01-fuzzyEngine.t view on Meta::CPAN
);
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],
t/01-fuzzyEngine.t view on Meta::CPAN
);
# 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' );
};
my @int_var_pars = ( # $from => $to MISSING --> internal
'low' => [0, 1, 10, 0],
'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',
t/01-fuzzyEngine.t view on Meta::CPAN
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',
);
t/01-fuzzyEngine.t view on Meta::CPAN
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
t/01-fuzzyEngine.t view on Meta::CPAN
# 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 {
ok( (not exists $INC{PDL}), 'Module does not load PDL' );
};
};
done_testing();
sub a_variable {
# Careful!
# a_variable does not register its result into $fuzzyEngine.
# ==> is missing in $fe->variables;
#
my ($fuzzyEngine, @pars) = @_;
my $v = var_class()->new( $fuzzyEngine,
0 => 1,
'low' => [0, 0],
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
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 {
# _cat_array_of_piddles
my @vals = (0..2);
my $vals = $class->_cat_array_of_piddles(@vals);
is( $vals->ndims, 1, 'ndims of cat topdl with scalars');
ok_all( $vals == pdl( [ 0, 1, 2 ] ),
'cat topdl with scalars',
);
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
'cat topdl two 2dim 4elem pdls',
) or diag $vals;
@vals = ( pdl([1]), pdl([]) );
throws_ok { $class->_cat_array_of_piddles(@vals)
} qr/empty/i,
'_cat_array_of_piddles checks for empty piddles';
};
subtest "$class PDL operations" => sub {
my $fe = $class->new();
# Negation:
my $c = $fe->not( 0.4 );
ok( ref $c eq '', 'not scalar: scalar' );
ok( $c == 0.6, 'not scalar: result' );
$c = $fe->not( pdl( 0.4 ) );
isa_ok( $c, 'PDL', 'not(PDL scalar)' );
ok( $c == 0.6, 'not(PDL scalar): result' );
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
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)' );
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
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;
};
subtest "$var_class fuzzification with piddles" => sub {
my $v = $var_class->new( $fe,
0 => 10,
'low' => [ 3, 1, 6, 0],
'med' => [ 5, 0.5],
'high' => [ -5, 0, 15, 1],
);
my $vals = pdl( [10, 5]);
$v->fuzzify( $vals );
isa_ok( $v->low, 'PDL', 'What $v->low returns' );
ok_all( $v->low == pdl([ 0, 1/3]), '$v->low' ); # :-))
ok_all( $v->med == pdl([0.5, 0.5]), '$v->med' );
ok_all( $v->high == pdl([3/4, 1/2]), '$v->high' );
};
subtest "$var_class defuzzification with piddles" => sub {
my $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( pdl(1, 0, 1) );
$v->high( 0.5 ); # non pdl
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
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;
# (Probably a stupide example)
my $fe = AI::FuzzyEngine->new();
# Declare variables as usual
my $severity = $fe->new_variable( 0 => 10,
low => [0, 1, 3, 1, 5, 0 ],
high => [ 3, 0, 5, 1, 10, 1],
t/02-fuzzyEngine-pdl_aware.t view on Meta::CPAN
my $problem_ratings = $problem->defuzzify();
# print 'Problems rated: ', $problem_ratings;
# [
# [ 0 0.60952381 0.60952381 0.60952381]
# [ 0 0.75 1 1]
# ]
ok( 1, 'POD synopsis' );
};
done_testing();
sub ok_all {
my ($p, $descr) = @_;
die 'First arg must be a piddle' unless ref $p eq 'PDL';
ok( $p->all() , $descr || '' );
}
sub a_variable {
# Careful!
# a_variable does not register its result into $fuzzyEngine.
( run in 0.285 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )