view release on metacpan or  search on metacpan

FuzzyInference/Set.pm  view on Meta::CPAN

    my @newCoords;
    my ($x, $y, $other);
    while (@coords1 && @coords2) {
	if ($coords1[0] < $coords2[0]) {
	    $x     = shift @coords1;
	    $y     = shift @coords1;
	    $other = $set2;
	} else {
	    $x     = shift @coords2;
	    $y     = shift @coords2;
	    $other = $set1;
	}
	my $val    = $self->membership($other, $x);
	$val = $y if $y > $val;
	push @newCoords => $x, $val;
    }

    push @newCoords => @coords1 if @coords1;
    push @newCoords => @coords2 if @coords2;

    return @newCoords;
}

sub min {    # min of two sets.
    my ($self,
	$set1,
	$set2,
	) = @_;

    my @coords1 = $self->coords($set1);
    my @coords2 = $self->coords($set2);

    my @newCoords;
    my ($x, $y, $other);
    while (@coords1 && @coords2) {
	if ($coords1[0] < $coords2[0]) {
	    $x     = shift @coords1;
	    $y     = shift @coords1;
	    $other = $set2;
	} else {
	    $x     = shift @coords2;
	    $y     = shift @coords2;
	    $other = $set1;
	}
	my $val    = $self->membership($other, $x);
	$val = $y if $y < $val;
	push @newCoords => $x, $val;
    }

    push @newCoords => @coords1 if @coords1;
    push @newCoords => @coords2 if @coords2;

    return @newCoords;
}

sub complement {
    my ($self, $name) = @_;

    my @coords = $self->coords($name);
    my $i = 0;
    return map {++$i % 2 ? $_ : 1 - $_} @coords;
}

sub coords {
    my ($self,
	$name,
	) = @_;

    return undef unless $self->exists($name);

    return @{$self->{TS}{$name}};
}

sub scale {  # product implication
    my ($self,
	$name,
	$scale,
	) = @_;

    my $i = 0;
    my @c = map { $_ * ++$i % 2 ? 1 : $scale } $self->coords($name);

    return @c;
}

sub clip {   # min implication
    my ($self,
	$name,
	$val,
	) = @_;

    my $i = 0;
    my @c = map {
	++$i % 2 ? $_ : $_ > $val ? $val : $_
	}$self->coords($name);

    return @c;
}

# had to roll my own centroid algorithm.
# not sure why standard algorithms didn't work
# correctly!
sub centroid {   # center of mass.
    my ($self,
	$name,
	) = @_;

    return undef unless $self->exists($name);

    my @coords = $self->coords($name);
    my @ar;

    my $x0 = shift @coords;
    my $y0 = shift @coords;
    my ($x1, $y1);

    while (@coords) {
	$x1 = shift @coords;
	$y1 = shift @coords;

	my $a1 = abs(0.5 * ($x1 - $x0) * ($y1 - $y0));
	my $c1 = (1/3) * ($x0 + $x1 + ($y1 > $y0 ? $x1 : $x0));

	my $a2 = abs(($x1 - $x0) * ($y0 < $y1 ? $y0 : $y1));
	my $c2 = $x0 + 0.5 * ($x1 - $x0);

	my $ta = $a1 + $a2;
	next if $ta == 0;

	my $c  = $c1 * ($a1 / $ta);
	$c    += $c2 * ($a2 / $ta);

	push @ar => [$c, $ta];
    } continue {
	$x0 = $x1;
	$y0 = $y1;
    }

    my $ta = 0;
    $ta += $_->[1] for @ar;

    my $c = 0;
    $c += $_->[0] * ($_->[1] / $ta) for @ar;

    return $c;
}

sub median {
    my ($self,
	$name,
	) = @_;

    my @coords = $self->coords($name);