view release on metacpan or  search on metacpan

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';
};

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"' );

    # Negation:
    my $c = $fe->not( 0.4 );
    is( $c, 0.6, '"not"' );

    # 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

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;
};

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!

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