view release on metacpan or  search on metacpan

lib/AI/FuzzyEngine/Set.pm  view on Meta::CPAN

    if ($found) {
        # Rest of procedure is known (and necessary)
        @x = sort {$a<=>$b} keys %yA_of;
        @yA = @yA_of{@x};
        @yB = @yB_of{@x};

        $funA->[0] = \@x;
        $funA->[1] = \@yA;
        $funB->[0] = \@x;
        $funB->[1] = \@yB;
    };

    return;
};

sub _max_of {
    my ($factor, $ar, $br) = @_;
    my @y;
    for my $ix ( reverse 0..$#$ar ) {
        my $max = $ar->[$ix] * $factor > $br->[$ix] * $factor ?
                                         $ar->[$ix] : $br->[$ix]; 
        $y[$ix] = $max;
    };
    return @y;
}

sub _minmax_of_pair_of_funs {
    my ($class, $factor, $funA, $funB) = @_;
    # $factor > 0: 'max' operation
    # $factor < 0: 'min' operation

    # synchronize interpolation points (original functions are changed)
    $class->synchronize_funs( $funA, $funB );

    my @x  = _x_of $funA;
    my @yA = _y_of $funA;
    my @yB = _y_of $funB;
    # my @y  = List::MoreUtils::pairwise { $a*$factor > $b*$factor ?
    #                                      $a : $b
    #                                    } @yA, @yB;

    my @y = _max_of( $factor, \@yA, \@yB ); # faster than pairwise

    return [ \@x, \@y ];
}

sub _minmax_of_funs {
    my ($class, $factor, $funA, @moreFuns) = @_;
    return $funA unless @moreFuns;

    my $funB = shift @moreFuns;
    my $fun  = $class->_minmax_of_pair_of_funs( $factor, $funA, $funB );

    # solve recursively
    return $class->_minmax_of_funs( $factor, $fun, @moreFuns );
}

sub min_of_funs {
    my ($class, @funs) = @_;
    # Copy can not moved to _minmax_of_funs (is recursively called)
    my @copied_funs = map { $class->_copy_fun($_) } @funs;
    return $class->_minmax_of_funs( -1, @copied_funs );
}

sub max_of_funs {
    my ($class, @funs) = @_;
    # Copy can not moved to _minmax_of_funs (is recursively called)
    my @copied_funs = map { $class->_copy_fun($_) } @funs;
    return $class->_minmax_of_funs( 1, @copied_funs );
}

sub clip_fun {
    my ($class, $fun, $max_y) = @_;

    # clip by min operation on function $fun
    my @x         = _x_of $fun;
    my @y         = ( $max_y ) x @x;
    my $fun_limit = [ \@x => \@y ];
    return $class->min_of_funs( $fun, $fun_limit );
}

sub centroid {
    my ($class, $fun) = @_;

    # x and y values, check
    my @x = _x_of $fun;
    my @y = _y_of $fun;
    croak "At least two points needed" if @x < 2;

    # using code fragments from Ala Qumsieh (AI::FuzzyInference::Set)

    # Left 
    my $x0 = shift @x;
    my $y0 = shift @y;

    my (@areas, $x1, $y1);

    AREA:
    while (@x) {
        # Right egde of area
        $x1 = shift @x;
        $y1 = shift @y;

        # Each area is build of a rectangle and a top placed triangle
        # Each of them might have a height of zero

        # Area and local centroid of base rectangle
        my $a1 = abs(($x1 - $x0) * ($y0 < $y1 ? $y0 : $y1));
   	my $c1 = $x0 + 0.5 * ($x1 - $x0);

        # Area and local centroid of triangle on top of rectangle
        my $a2 = abs(0.5 * ($x1 - $x0) * ($y1 - $y0));
        my $c2 = (1/3) * ($x0 + $x1 + ($y1 > $y0 ? $x1 : $x0));

        # Total area of block
        my $ta = $a1 + $a2;
   	next AREA if $ta == 0;

        # Total centroid of block
        my $c = ( $c1*$a1 + $c2*$a2 ) / $ta;

        # Store them for final calculation of average
        push @areas, [$c, $ta];
    }
    continue {
        # Left edge of next area
        ($x0, $y0) = ($x1, $y1);
    };