view release on metacpan or  search on metacpan

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

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

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

    my $w  = $var_class->new( $fe,
                              0 => 2,
                              '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 {