view release on metacpan or  search on metacpan

t/01-fuzzyEngine.t  view on Meta::CPAN

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

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

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