view release on metacpan or  search on metacpan

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 {

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

    @vals = map {pdl([$_])} (0..2);
    $vals = $class->_cat_array_of_piddles(@vals);
    is( $vals->ndims, 2, 'ndims of cat topdl with pdl([scalar])' );
    ok_all( $vals == pdl( [ [0], [1], [2], ] ),
            'cat topdl with scalars',
          );

    @vals = map {pdl([[$_, 1], [7]])} (0..2);
    $vals = $class->_cat_array_of_piddles(@vals);
    is( $vals->ndims, 3, 'cat of 2dim' );

    @vals =( 6, pdl( [[5, 7], [1, 2]] ) );
    $vals = $class->_cat_array_of_piddles(@vals);
    ok_all( $vals == pdl( [[6, 6], [6, 6]],
                          [[5, 7], [1, 2]],
                        ),
            'cat topdl scalar, 2dim 4elem pdl',
          ) or diag $vals;

    @vals = ( pdl([[11],[21]]), pdl([[11, 12]]));
    $vals = $class->_cat_array_of_piddles(@vals);
    ok_all( $vals == pdl( [[11, 11], [21, 21]],
                          [[11, 12], [11, 12]],
                        ),
            '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' );

    $c = $fe->not( pdl([0.4, 0.5], [0, 1]) );
    isa_ok( $c, 'PDL',                     'not(PDL 2elem)'         );
    ok_all( $c == pdl([0.6, 0.5], [1, 0]), 'not(PDL 2elem): result' );

    # And and or use _cat_array_of_piddles
    # to bring input to the same dimensions
    # And
    $c = $fe->and( 0.4, pdl( [0.5] ) );
    isa_ok( $c, 'PDL', 'and(scalar, PDL)'         );
    ok_all( $c == 0.4, 'and(scalar, PDL): result' );

    $c = $fe->and( 0.6, pdl( [0.5, 0.7] ) );
    isa_ok( $c, 'PDL',             'and(scalar, 2elem PDL)'         );
    ok_all( $c == pdl([0.5, 0.6]), 'and(scalar, 2elem PDL): result' );

    # Or
    $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)'         );