AI-FuzzyInference
view release on metacpan or search on metacpan
FuzzyInference.pm view on Meta::CPAN
############################################
#
# First some global vars.
#
############################################
# this hash defines the possible interpretations of the
# standard fuzzy logic operations.
my %_operations = (
'&' => {
min => sub { (sort {$a <=> $b} @_)[0] },
product => sub { my $p = 1; $p *= $_ for @_; $p },
default => 'min',
},
'|' => {
max => sub { (sort {$a <=> $b} @_)[-1] },
sum => sub { my $s = 0; $s += $_ for @_; $s > 1 ? 1 : $s },
default => 'max',
},
'!' => {
complement => sub { 1 - $_[0] },
custom => sub {},
default => 'complement',
},
);
# this hash defines the currently implemented implication methods.
my %_implication = qw(
clip 1
scale 1
default clip
);
FuzzyInference.pm view on Meta::CPAN
max 1
default max
);
# this hash defines the currently implemented defuzzification methods.
my %_defuzzification = qw(
centroid 1
default centroid
);
# sub new() - constructor.
#
# doesn't take any arguments. Returns an initialized AI::FuzzyInference object.
sub new {
my $self = shift;
my $class = ref($self) || $self;
my $obj = bless {} => $class;
$obj->_init;
return $obj;
}
# sub _init() - private method.
#
# no arguments. Initializes the data structures we will need.
# It also defines the default logic operations we might need.
sub _init {
my $self = shift;
$self->{SET} = new AI::FuzzyInference::Set;
$self->{INVARS} = {};
$self->{OUTVARS} = {};
$self->{RULES} = [];
$self->{RESULTS} = {};
$self->{IMPLICATION} = $_implication{default};
$self->{AGGREGATION} = $_aggregation{default};
$self->{DEFUZZIFICATION} = $_defuzzification{default};
for my $op (qw/& | !/) {
$self->{OPERATIONS}{$op} = $_operations{$op}{default};
}
}
# sub implication() - public method.
#
# one optional argument: has to match one of the keys of the %_implication hash.
# used to query/set the implication method.
sub implication {
my ($self,
$new,
) = @_;
if (defined $new and exists $_implication{$new}) {
$self->{IMPLICATION} = $new;
}
return $self->{IMPLICATION};
}
# sub aggregation() - public method.
#
# one optional argument: has to match one of the keys of the %_aggregation hash.
# used to query/set the aggregation method.
sub aggregation {
my ($self,
$new,
) = @_;
if (defined $new and exists $_aggregation{$new}) {
$self->{AGGREGATION} = $new;
}
return $self->{AGGREGATION};
}
# sub defuzzification() - public method.
#
# one optional argument: has to match one of the keys of the %_defuzzification hash.
# used to query/set the defuzzification method.
sub defuzzification {
my ($self,
$new,
) = @_;
if (defined $new and exists $_defuzzification{$new}) {
$self->{DEFUZZIFICATION} = $new;
}
return $self->{DEFUZZIFICATION};
}
# sub operation() - public method.
#
# two arguments: first one mandatory and specifies the logic operation
# in question. Second one is optional and has to match one of the keys
# of the %{$_operations{$first_arg}} hash.
# Used to query/set the logic operations method.
sub operation {
my ($self,
$op,
$new,
) = @_;
return unless defined $op && exists $_operations{$op};
if (defined $new and exists $_operations{$op}{$new}) {
$self->{OPERATIONS}{$op} = $new;
}
return $self->{OPERATIONS}{$op};
}
# sub inVar() - public method.
#
# 4 arguments or more : First is a name of a new input variable.
# Second and third are the min and max values of that variable.
# These define the universe of discourse for that variable.
# Additional argumets constitute a hash. The keys of the hash
# are term set names defined for the given variable. The values
# are the coordinates of the vertices of the term sets.
#
# ex. $obj->inVar('height',
# 5, 8, # xmin, xmax (in feet, say)
# 'tall' => [0, 0,
# 5, 1,
# 10,0],
# ....);
sub inVar {
my ($self,
$var,
$xmin,
$xmax,
@sets,
) = @_;
$self->{INVARS}{$var} = [$xmin, $xmax];
while (@sets) {
my $s = shift @sets;
my $c = shift @sets;
$self->{SET}->add("$var:$s", $xmin, $xmax, @$c);
}
}
# sub outVar() - public method.
#
# 4 arguments or more : First is a name of a new output variable.
# Second and third are the min and max values of that variable.
# These define the universe of discourse for that variable.
# Additional argumets constitute a hash. The keys of the hash
# are term set names defined for the given variable. The values
# are the coordinates of the vertices of the term sets.
sub outVar {
my ($self,
$var,
$xmin,
$xmax,
@sets,
) = @_;
$self->{OUTVARS}{$var} = [$xmin, $xmax];
while (@sets) {
my $s = shift @sets;
my $c = shift @sets;
$self->{SET}->add("$var:$s", $xmin, $xmax, @$c);
}
}
# sub addRule() - public method.
#
# Adds fuzzy if-then inference rules.
#
# $obj->addRule('x=medium' => 'z = slow',
# 'x=low & y=small' => 'z = fast',
# 'x=high & y=tiny' => 'z=veryfast');
# spaces are optional. The characters [&=|] are special.
sub addRule {
my ($self, %rules) = @_;
for my $k (keys %rules) {
my $v = $rules{$k};
s/\s+//g for $v, $k;
push @{$self->{RULES}} => [$k, $v];
}
return 1;
}
# sub show() - public method.
#
# This method displays the computed values of all
# output variables.
# It is ugly, and will be removed. Here for debugging.
sub show {
my $self = shift;
for my $var (keys %{$self->{RESULTS}}) {
print "Var $var = $self->{RESULTS}{$var}.\n";
}
}
# sub value() - public method.
#
# one argument: the name of an output variable.
# This method returns the computed value of a given output var.
sub value {
my ($self,
$var,
) = @_;
return undef unless exists $self->{RESULTS}{$var};
return $self->{RESULTS}{$var};
}
# sub reset() - public method
#
# cleans the data structures used.
sub reset {
my $self = shift;
my @list = $self->{SET}->listMatching(q|:implicated$|);
push @list => $self->{SET}->listMatching(q|:aggregated$|);
$self->{SET}->delete($_) for @list;
$self->{RESULTS} = {};
}
# sub compute() - public method
#
# This method takes as input crisp values for each
# of the input vars, and produces a crisp output value
# based on the application of the fuzzy if-then rules.
# ex.
# $z = $obj->compute(x => 5,
# y => 24);
sub compute {
my ($self,
%vars,
) = @_;
$self->reset();
# First thing we do is to fuzzify the inputs.
$self->_fuzzify(%vars);
# Now, apply the rules to see which ones fire.
FuzzyInference.pm view on Meta::CPAN
# aggregate
$self->_aggregate;
# defuzzify .. final step.
$self->_defuzzify;
return 1;
}
# sub _defuzzify() - private method.
#
# no arguments. This method applies the defuzzification technique
# to get a crisp value out of the aggregated set of each output
# var.
sub _defuzzify {
my $self = shift;
my $_defuzzification = $self->{DEFUZZIFICATION};
# iterate through all output vars.
for my $var (keys %{$self->{OUTVARS}}) {
my $result = 0;
if ($self->{SET}->exists("$var:aggregated")) {
$result = $self->{SET}->$_defuzzification("$var:aggregated");
}
$self->{RESULTS}{$var} = $result;
}
}
# sub _aggregate() - private method.
#
# no arguments. This method applies the aggregation technique to get
# one fuzzy set out of the implicated sets of each output var.
sub _aggregate {
my $self = shift;
my $_aggregation = $self->{AGGREGATION};
# iterate through all output vars.
for my $var (keys %{$self->{OUTVARS}}) {
# get implicated sets.
my @list = $self->{SET}->listMatching("\Q$var\E:.*:implicated\$");
FuzzyInference.pm view on Meta::CPAN
my @c = $self->{SET}->coords($current);
$self->{SET}->add("$var:aggregated", @{$self->{OUTVARS}{$var}}, @c);
# delete the temporary sets.
for my $j (0 .. $i - 1) {
$self->{SET}->delete("temp$j");
}
}
}
# sub _implicate() - private method.
#
# no arguments. This method applies the implication technique
# to all the fired rules to find a support value for each
# output variable.
sub _implicate {
my $self = shift;
my $_implication = $self->{IMPLICATION};
my %ind;
for my $ref (@{$self->{FIRED}}) {
my ($i, $val) = @$ref;
my ($var, $ts) = split /=/, $self->{RULES}[$i][1];
if ($val > 0) {
$ind{$var}{$ts}++;
my @c = $self->{SET}->$_implication("$var:$ts", $val);
my @u = @{$self->{OUTVARS}{$var}}; # the universe
$self->{SET}->add("$var:$ts:$ind{$var}{$ts}:implicated", @u, @c);
}
}
}
# sub _fuzzify() - private method.
#
# one argument: a hash. The keys are input variables. The
# values are the crisp values of the input variables (same arguments
# as compute()). It finds the degree of membership of each input
# variable in each of its term sets.
sub _fuzzify {
my ($self, %vars) = @_;
my %terms;
for my $var (keys %vars) {
my $val = $vars{$var};
for my $ts ($self->{SET}->listMatching("\Q$var\E")) {
my $deg = $self->{SET}->membership($ts, $val);
$terms{$var}{$ts} = $deg;
}
}
$self->{FUZZIFY} = \%terms;
}
# sub _infer() - private method.
#
# no arguments. This method applies the logic operations to combine
# multiple parts of the antecedent of a rule to get one crisp value
# that is the degree of support of that rule.
# Rules with positive support "fire".
sub _infer {
my $self = shift;
my @fired; # keep list of fired rules.
for my $i (0 .. $#{$self->{RULES}}) {
my $r = $self->{RULES}[$i][0]; # precedent
my $val = 0;
while ($r =~ /([&|]?)([^&|]+)/g) {
my ($op, $ant) = ($1, $2);
FuzzyInference.pm view on Meta::CPAN
This method takes as input a set of hash-value pairs; the keys are names
of input variables, and the values are the values of the variables. It
runs those values through the FIS, generating corresponding values for
the output variables. It always returns a true value. To get the actual
values of the output variables, look at the C<value()> method below.
Example:
$obj->compute(x => 5,
y => 24);
Note that any subsequent call to C<compute()> will implicitly clear out
the old computed values before recomputing the new ones. This is done
through a call to the C<reset()> method below.
=item value()
This method returns the value of the supplied output variable. It only
works for output variables (defined using the C<outVar()> method),
and only returns useful results after a call to C<compute()> has been
made.
FuzzyInference/Set.pm view on Meta::CPAN
package AI::FuzzyInference::Set;
use strict;
#our $VERSION = 0.02;
use vars qw/$VERSION/; # a bit more backward compatibility.
$VERSION = 0.04;
1;
sub new {
my $self = shift;
my $class = ref($self) || $self;
my $obj = bless {} => $class;
$obj->_init;
return $obj;
}
sub _init {
my $self = shift;
$self->{TS} = {};
$self->{AREA} = {};
}
sub add {
my ($self,
$name,
$xmin,
$xmax,
@coords,
) = @_;
# make sure coords span the whole universe.
if ($coords[0] > $xmin) {
unshift @coords => ($xmin, $coords[1]);
}
if ($coords[-2] < $xmax) {
push @coords => ($xmax, $coords[-1]);
}
$self->{TS}{$name} = \@coords;
}
sub delete {
my ($self,
$name,
) = @_;
delete $self->{$_}{$name} for qw/TS AREA/;
}
sub membership {
my ($self,
$name,
$val,
) = @_;
return undef unless $self->exists($name);
my $deg = 0;
my @c = $self->coords($name);
FuzzyInference/Set.pm view on Meta::CPAN
$y1 = $y2;
next;
}
$deg = $y2 - ($y2 - $y1) * ($x2 - $val) / ($x2 - $x1);
last;
}
return $deg;
}
sub listAll {
my $self = shift;
return keys %{$self->{TS}};
}
sub listMatching {
my ($self, $rgx) = @_;
return grep /$rgx/, keys %{$self->{TS}};
}
sub max { # max of two sets.
my ($self,
$set1,
$set2,
) = @_;
my @coords1 = $self->coords($set1);
my @coords2 = $self->coords($set2);
my @newCoords;
my ($x, $y, $other);
FuzzyInference/Set.pm view on Meta::CPAN
$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);
FuzzyInference/Set.pm view on Meta::CPAN
$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;
FuzzyInference/Set.pm view on Meta::CPAN
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);
# hmmm .. how do I do *this*?
return 0;
}
sub exists {
my ($self,
$name,
) = @_;
return exists $self->{TS}{$name};
}
sub uniquify {
my $self = shift;
my @new;
my %seen;
while (@_) {
my $x = shift;
my $y = shift;
next if $seen{$x};
push @new => ($x, $y);
$seen{$x} = 1;
}
return @new;
}
sub area {
my ($self, $name) = @_;
return $self->{AREA}{$name} if exists $self->{AREA}{$name};
my @coords = $self->coords($name);
my $x0 = shift @coords;
my $y0 = shift @coords;
my $area = 0;
This method takes as input a set of hash-value pairs; the keys are
names of input variables, and the values are the values of the
variables. It runs those values through the FIS, generating
corresponding values for the output variables. It always returns a
true value. To get the actual values of the output variables, look
at the "value()" method below. Example:
$obj->compute(x => 5,
y => 24);
Note that any subsequent call to "compute()" will implicitly clear
out the old computed values before recomputing the new ones. This is
done through a call to the "reset()" method below.
value()
This method returns the value of the supplied output variable. It
only works for output variables (defined using the "outVar()"
method), and only returns useful results after a call to "compute()"
has been made.
reset()
( run in 0.882 second using v1.01-cache-2.11-cpan-88abd93f124 )