AI-Fuzzy
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
Revision history for Perl extension AI::Fuzzy.
0.05 Sat Jan 4 10:20:29 EST 2003
- found problem with stringifycation in Set.pm
- fixed warning messages due to not checking "exists" for hash
values in Set.pm (union,intersection). Thanks to Richard Jelinek
for pointing this out, and a problem in the code in the docs.
0.04 Fri Dec 6 13:49:55 EST 2002
- replaced current AI::Fuzzy::Label with a new AI::Fuzzy::Axis (a container for label objects)
and changed AI::Fuzzy::Label to be concerned only about label data. This
will allow us to add new AI::Fuzzy::Label{Spline, Trapezoid, etc.} subclasses
of labels to the now independent Axis class. Axis will defer to the Label
itself to decide applicability, >,<,>=,<=, and the like.
- changed test.pl to work with the new setup
- added functions: greaterthan, greaterequal, lessthan, lessequal, and between
to AI::Fuzzy::Label
- added overriding of >,>=,<,<=, and <=> in AI::Fuzzy::Label.
0.03 Wed Oct 9 18:07:34 EDT 2002
- added functions: support, core, height, is_normal, is_subnormal
to AI::Fuzzy::Set
0.02 Wed Oct 9 16:41:29 EDT 2002
- ownership transfering to Tom Scanlan <tscanlan@openreach.com>
- added functions to AI::Fuzzy::Set for intersection, union,
complement, equal, and as_string
- made a heck of a lot of tests. use them as examples...
0.01 Mon Jul 19 19:33:46 1999
- original version; created by h2xs 1.18
package AI::Fuzzy;
use strict;
use vars qw($VERSION);
use AI::Fuzzy::Set;
use AI::Fuzzy::Axis;
use AI::Fuzzy::Label;
$VERSION = '0.05';
1;
__END__
=head1 NAME
AI::Fuzzy - Perl extension for Fuzzy Logic
=head1 SYNOPSIS
use AI::Fuzzy;
my $f = new AI::Fuzzy::Axis;
my $l = new AI::Fuzzy::Label("toddler", 1, 1.5, 3.5);
$f->addlabel("baby", -1, 1, 2.5);
$f->addlabel($l);
$f->addlabel("little kid", 2, 7, 12);
$f->addlabel("kid", 6, 10, 14);
$f->addlabel("teenager", 12, 16, 20);
$f->addlabel("young adult", 18, 27, 35);
$f->addlabel("adult", 25, 50, 75);
$f->addlabel("senior", 60, 80, 110);
$f->addlabel("relic", 100, 150, 200);
for (my $x = 0; $x<50; $x+=4) {
print "$x years old => " . $f->labelvalue($x) . "\n";
}
$a = new AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "a is: " . $a->as_string . "\n";
print "b is: " . $b->as_string . "\n";
print "a is equal to b" if ($a->equal($b));
my $c = $a->complement();
print "complement of a is: " . $c->as_string . "\n";
$c = $a->union($b);
print "a union b is: " . $c->as_string . "\n";
$c = $a->intersection($b);
print "a intersection b is: " . $c->as_string . "\n";
__END__
=head1 DESCRIPTION
AI::Fuzzy really consists of three modules - AI::Fuzzy::Axis, AI::Fuzzy::Label, and
AI::Fuzzy::Set.
A fuzzy set is simply a mathematical set to which members can
I<partially> belong. For example, a particular shade of gray may
partially belong to the set of dark colors, whereas black would have
full membership, and lemon yellow would have almost no membership.
A fuzzy axis holds fuzzy labels and can be used to classify values
by examining the degree to which they belong to several labels, and
selecting the most appropriate. For example, it can decide whether
to call water at 60 degrees Farenheight "cold", "cool", or "warm".
A fuzzy label classifies a particular range of the Axis. In the above example
the label is one of "cold", "cool", or "warm". A fuzzy label defines how
much a crisp value belongs to the classifier such as "cold", "warm", or "cool".
=head2 Fuzzy Sets
AI::Fuzzy:Set has these methods:
$fs = B<new> AI::Fuzzy::Set;
# here, "Bob" is unquestionably tall.. the others less so.
$fs_tall_people = B<new> AI::Fuzzy::Set( Lester=>.34, Bob=>1.00, Max=>.86 );
# $x will be .86
$x = B<membership> $fs_tall_people, "Max";
# get list of members, sorted from least membership to greatest:
@shortest_first = B<members> $fs_tall_people;
$fs = B<new> AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
B<complement>, B<union>, B<intersection>
Thesie are the fuzzy set version of the typical functions.
B<equal>
Returns true if the sets have the same elements and those elements
are all equal.
B<as_string>
Prints the set as tuples:
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "b is: " . $b->as_string . "\n";
prints:
b is: x8/0, x5/0.3, x6/0.5, x7/0.8, x9/1
=head2 Fuzzy Labels
A Fuzzy::Label label has four attributes: the text of the label (it
can be any scalar, really), and three numbers: low, mid, high if you
imagine a cartesian plane (remember graph paper in algebra?) of all
possible values, the label applies to a particular range. the graph
might look something like this:
|Y * (mid, 1)
| / \
| / \
| / \
| / \
-|-------*-------------*------- X
(low,0) (high,0)
the Y value is applicability of the label for a given X value
the mid number is the "pure" value. eg, orange is at 0 or 360
degrees on the color wheel. the label applies 100% at the mid
point.
the low and high numbers are the two points at which
the label ceases to apply.
note that labels can overlap, and that the
mid number isn't always in the exact center, so the slope
of the two sides may vary...
$fl = new AI::Fuzzy::Label ( "hot", 77, 80, 100 );
$fx = new AI::Fuzzy::Label ( "cold", 0, 10, 200 );
# what I consider hot. :) (in Farenheit, of course!)
if ( $fl->lessthan($fx) ) {
print "the laws of nature have changed\n";
}
# there is a lessthan, greaterthan, lessequal, greaterequal, and between
# that functions as above or using <,>,<=,>=
$a = $fl->applicability($value);
# $a is now the degree to which this label applies to $value
=head2 Fuzzy Axis
A Fuzzy::Axis maintains a hash of labels. Thus you can now look at how
values apply to the full range of labels. The graph of an Axis might
look like this:
|Y * (mid, 1)
| /\/ \ /|
| /- -\ / /\ \ / |
| / \-/ / \ \ / | (some function on some range of x)
| | / \ /\ ---*-|
-|---------*-----------*------- X
(low,0) (high,0)
the Y value is still the applicability of the label for a given X value,
but there are three labels on this Axis. A different X value may
put your value into a new label.
$fl = new AI::Fuzzy::Axis;
$fl->addlabel($label);
# add a label created as in AI::Fuzzy::Label docs
$a = $fl->applicability($label, $value);
# $a is now the degree to which $label applies to $value
$l = $fl->label ("labelname");
# returns the label object named "labelname"
$l = $fl->labelvalue ($value);
# applies a label to $value
@l = $fl->labelvalue($value);
# returns a list of labels and their applicability values
$s = new AI::Fuzzy::Set( $fl->label($value) );
# same thing, but now it's an object
@range = $fl->range();
# returns a list of labels, sorted by their midpoints
# eg: ("cold", "cool", "lukewarm", "warm", "hot")
=head1 AUTHOR
Tom Scanlan <tscanlan@openreach.com>,
current maintainer
Michal Wallace (sabren@manifestation.com),
original author
=head1 SEE ALSO
Move along, nothing to "see also" here...
=head1 BUGS
Please send any bugs to Tom Scanlan <tscanlan@openreach.com>
=cut
demo/cpu.pl
demo/fuzz.pl
Changes
Fuzzy.pm
MANIFEST
README
Makefile.PL
test.pl
lib/AI/Fuzzy/Set.pm
lib/AI/Fuzzy/Label.pm
lib/AI/Fuzzy/Axis.pm
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'AI::Fuzzy',
'VERSION_FROM' => 'Fuzzy.pm', # finds $VERSION
);
NAME
AI::Fuzzy - Perl extension for Fuzzy Logic
SYNOPSIS
use AI::Fuzzy;
my $f = new AI::Fuzzy::Label;
$f->addlabel("baby", -1, 1, 2.5);
$f->addlabel("toddler", 1, 1.5, 3.5);
$f->addlabel("little kid", 2, 7, 12);
$f->addlabel("kid", 6, 10, 14);
$f->addlabel("teenager", 12, 16, 20);
$f->addlabel("young adult", 18, 27, 35);
$f->addlabel("adult", 25, 50, 75);
$f->addlabel("senior", 60, 80, 110);
$f->addlabel("relic", 100, 150, 200);
for (my $x = 0; $x<50; $x+=4) {
print "$x years old => " . $f->label($x) . "\n";
}
$a = new AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "a is: " . $a->as_string . "\n";
print "b is: " . $b->as_string . "\n";
print "a is equal to b" if ($a->equal($b));
$c = $a->complement();
print "complement of a is: " . $c->as_string . "\n";
$c = $a->union($b);
print "a union b is: " . $c->as_string . "\n";
$c = $a->intersection($b);
print "a intersection b is: " . $c->as_string . "\n";
__END__
DESCRIPTION
AI::Fuzzy really consists of two modules - AI::Fuzzy::Label and
AI::Fuzzy::Set.
A fuzzy set is simply a mathematical set to which members can
*partially* belong. For example, a particular shade of gray may
partially belong to the set of dark colors, whereas black would have
full membership, and lemon yellow would have almost no membership.
A fuzzy labeler classifies a particular crisp value by examining the
degree to which it belongs to several sets, and selecting the most
appropriate. For example, it can decide whether to call water at 60
degrees Farenheight "cold", "cool", or "warm". A fuzzy label might be
one of these labels, or a fuzzy set describing to what degree each of
the labels describes the particular value in question.
Fuzzy Sets
AI::Fuzzy:Set has these methods:
$fs = B<new> AI::Fuzzy::Set;
# here, "Bob" is unquestionably tall.. the others less so.
$fs_tall_people = B<new> AI::Fuzzy::Set( Lester=>.34, Bob=>1.00, Max=>.86 );
# $x will be .86
$x = B<membership> $fs_tall_people, "Max";
# get list of members, sorted from least membership to greatest:
@shortest_first = B<members> $fs_tall_people;
$fs = B<new> AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
B<complement>, B<union>, B<intersection>
Thesie are the fuzzy set version of the typical functions.
B<equal>
Returns true if the sets have the same elements and those elements
are all equal.
B<as_string>
Prints the set as tuples:
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "b is: " . $b->as_string . "\n";
prints:
b is: x8/0, x5/0.3, x6/0.5, x7/0.8, x9/1
Fuzzy Labels
A Fuzzy::Label label has four attributes: the text of the label (it can
be any scalar, really), and three numbers: low, mid, high if you imagine
a cartesian plane (remember graph paper in algebra?) of all possible
values, the label applies to a particular range. the graph might look
something like this:
|Y * (mid, 1)
| / \
| / \
| / \
| / \
-|-------*-------------*------- X
(low,0) (high,0)
the Y value is applicability of the label for a given X value
the mid number is the "pure" value. eg, orange is at 0 or 360 degrees on
the color wheel. the label applies 100% at the mid point.
the low and high numbers are the two points at which the label ceases to
apply.
note that labels can overlap, and that the mid number isn't always in
the exact center, so the slope of the two sides may vary...
$fl = new AI::FuzzyLabel;
$fl->addlabel( "hot", 77, 80, 100 ); # what I consider hot. :) (in
Farenheit, of course!)
$a = $fl->applicability($label, $value); # $a is now the degree to which
$label applies to $value
$l = $fl->label ($value); # applies a label to $value
@l = $fl->label($value); # returns a list of labels and their
applicability values
$s = new AI::Fuzzy::Set( $fl->label($value) ); # same thing, but now
it's an object
@range = $fl->range(); # returns a list of labels, sorted by their
midpoints # eg: ("cold", "cool", "lukewarm", "warm", "hot")
AUTHOR
Tom Scanlan <tscanlan@openreach.com>, current maintainer
Michal Wallace (sabren@manifestation.com), original author
SEE ALSO
Move along, nothing to "see also" here...
BUGS
Please send any bugs to Tom Scanlan <tscanlan@openreach.com>
demo/cpu.pl view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use AI::Fuzzy;
my $f = new AI::Fuzzy::Label;
$f->addlabel("completely idle", 99, 100, 101);
$f->addlabel("very idle", 90, 95, 100);
$f->addlabel("idle", 80, 87, 92);
$f->addlabel("somewhat idle", 40, 65, 80);
$f->addlabel("somewhat busy", 20, 45 , 60);
$f->addlabel("busy", 8, 13, 20);
$f->addlabel("very busy", 0, 5, 10);
$f->addlabel("completely busy", -1, 0, 1);
my $count=100;
while (1) {
open (STAT, "vmstat -n 1 $count |") or die ("can't find vmstat");
my $cpu = <STAT>; # headers
$cpu = <STAT>; # headers
for (1 .. $count ) {
$cpu = <STAT>; # read data
$cpu =~ s/.* (\d+)$/$1/;
chomp $cpu;
print "the cpu is: $cpu " . $f->label($cpu) . "\n";
}
close STAT;
sleep 1;
}
demo/fuzz.pl view on Meta::CPAN
#!/usr/bin/perl
use lib qw(blib/arch blib/lib ../blib/arch ../blib/lib);
use strict;
use warnings;
use AI::Fuzzy;
my $f = new AI::Fuzzy::Axis;
my $l = new AI::Fuzzy::Label("toddler", 1, 1.5, 3.5);
#print "$l\n";
$f->addlabel("baby", -1, 1, 2.5);
$f->addlabel($l);
$f->addlabel("little kid", 2, 7, 12);
$f->addlabel("kid", 6, 10, 14);
$f->addlabel("teenager", 12, 16, 20);
$f->addlabel("young adult", 18, 27, 35);
$f->addlabel("adult", 25, 50, 75);
$f->addlabel("senior", 60, 80, 110);
$f->addlabel("relic", 100, 150, 200);
for (my $x = 0; $x<50; $x+=4) {
print "$x years old => " . $f->labelvalue($x) . "\n";
}
$a = new AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "a is: " . $a->as_string . "\n";
print "b is: " . $b->as_string . "\n";
print "a is equal to b" if ($a->equal($b));
my $c = $a->complement();
print "complement of a is: " . $c->as_string . "\n";
$c = $a->union($b);
print "a union b is: " . $c->as_string . "\n";
$c = $a->intersection($b);
print "a intersection b is: " . $c->as_string . "\n";
lib/AI/Fuzzy/Axis.pm view on Meta::CPAN
package AI::Fuzzy::Axis;
use AI::Fuzzy::Label;
## Container for Fuzzy Labels ####
sub new {
my ($class) = @_;
my $self = {};
$self->{labels} = {};
bless $self, $class;
return $self;
}
sub addlabel {
# adds a label for a range of values..
my ($self, $label, $low, $mid, $high) = @_;
if ($label->can("name") ) {
$self->{labels}->{$label->name} = $label;
} else {
$self->{labels}->{$label} = new AI::Fuzzy::Label($label, $low, $mid, $high);
}
return $self->{labels}->{$label};
}
sub applicability {
# this function should be called something else..
# calculates to what degree $label applies to a $value
my ($self, $value, $label) = @_;
my $membership = 0;
return $label->applicability($value) if ($label->can("applicability"));
return undef unless ( exists $self->{labels}->{$label} );
return $self->{labels}->{$label}->applicability($value);
}
sub label {
# returns a label associated with this text
my ($self, $name) = @_;
return $self->{labels}->{$name};
}
sub labelvalue {
# returns a label associated with this value
my ($self, $value) = @_;
my $label;
my %weight;
my $total_weight = 0;
my @range = $self->range();
# first, find out the applicability of each label
# and weight the labels accordingly.
foreach $label (@range) {
my $labelname ;
my $w;
if ($label->can("name")) {
$labelname = $label->name;
$w = $label->applicability($value);
} else {
$labelname = $label;
$w = $self->applicability($value, $label);
}
next unless $w > 0;
$weight{$labelname} = $w;
$total_weight += $weight{$labelname};
}
# in list context, just return the weights
if (wantarray) {
return %weight;
}
# give up if no labels apply
return 0 unless $total_weight > 0;
# otherwise, use those weights as probabilities
# and randomly pick a label:
my $v = rand $total_weight;
my $x = 0;
# it doesn't matter how %weight is sorted..
foreach $label (keys %weight) {
$x += $weight{$label};
return $self->{labels}->{$label} if $x >= $v;
}
# and if none of that worked..
return 0;
}
sub range {
# returns a list of sorted labels
my ($self) = @_;
my $l = $self->{labels};
return sort { $a <=> $b } values %{$l};
}
sub lessthan {
my ($self, $labela, $labelb) = @_;
if ( exists $self->{labels}->{$labela} and exists $self->{labels}->{$labelb} ) {
my $la = $self->{labels}->{$labela};
my $lb = $self->{labels}->{$labelb};
return $la->lessthan($lb);
} else {
return undef;
}
}
sub lessequal {
my ($self, $labela, $labelb) = @_;
if ( exists $self->{labels}->{$labela} and exists $self->{labels}->{$labelb} ) {
my $la = $self->{labels}->{$labela};
my $lb = $self->{labels}->{$labelb};
return $la->lessequal($lb);
} else {
return undef;
}
}
sub greaterthan {
my ($self, $labela, $labelb) = @_;
if ( exists $self->{labels}->{$labela} and exists $self->{labels}->{$labelb} ) {
my $la = $self->{labels}->{$labela};
my $lb = $self->{labels}->{$labelb};
return $la->greaterthan($lb);
} else {
return undef;
}
}
sub greaterequal {
my ($self, $labela, $labelb) = @_;
if ( exists $self->{labels}->{$labela} and exists $self->{labels}->{$labelb} ) {
my $la = $self->{labels}->{$labela};
my $lb = $self->{labels}->{$labelb};
return $la->greaterequal($lb);
} else {
return undef;
}
}
sub between {
my ($self, $labela, $labelb, $labelc) = @_;
if ( exists $self->{labels}->{$labela} and exists $self->{labels}->{$labelb}
and exists $self->{labels}->{$labelc} ) {
my $la = $self->{labels}->{$labela};
my $lb = $self->{labels}->{$labelb};
my $lc = $self->{labels}->{$labelc};
return $la->between($lb, $lc);
} else {
return undef;
}
}
1;
lib/AI/Fuzzy/Label.pm view on Meta::CPAN
package AI::Fuzzy::Label;
## Fuzzy Label ####
use overload ( '>' => \&greaterthan,
'<' => \&lessthan,
'>=' => \&greaterequal,
'<=' => \&lessequal,
'<=>'=> \&spaceship,
'""' => \&stringify
);
sub new {
my ($class, $name, $low, $mid, $high) = @_;
my $self = {};
bless $self, $class;
$self->{name} = $name;
$self->{low} = $low;
$self->{mid} = $mid;
$self->{high} = $high;
return $self;
}
sub name {
my ($self, $name) = @_;
$self->{name} = $name if ($name);
return $self->{name};
}
sub stringify {
my $self=shift;
return qq([$self->{name}: $self->{low},$self->{mid},$self->{high}]);
}
sub lessthan {
my ($self, $that) = @_;
if ($self->{low} < $that->{low}) {
return 1;
} else {
return 0;
}
}
sub lessequal {
my ($self, $that) = @_;
if ($self->{low} <= $that->{low}) {
return 1;
} else {
return 0;
}
}
sub greaterthan {
my ($self, $that) = @_;
if ($self->{high} > $that->{high}) {
return 1;
} else {
return 0;
}
}
sub greaterequal {
my ($self, $that) = @_;
if ($self->{high} >= $that->{high}) {
return 1;
} else {
return 0;
}
}
sub between {
my ($self, $that1, $that2) = @_;
if ( ( $that1 <= $self and $self <= $that2) ||
( $that2 <= $self and $self <= $that1) ) {
return 1;
} else {
return 0;
}
}
sub spaceship {
my ($self, $that) = @_;
return ( $self->{mid} <=> $that->{mid} );
}
sub applicability {
# this function should be called something else..
# calculates to what degree this label applies to a $value
my ($self, $value) = @_;
my $membership = 0;
# if the low and mid points are same as value, full membership
# same if mid and high are same as value
if ($self->{mid} == $self->{low} && $value == $self->{low}) { return 1 };
if ($self->{high} == $self->{mid} && $value == $self->{high}) { return 1 };
# m = slope of the line.. (change in y/change in x)
# change in y is 1 as membership increases, -1 as it decreases
my $mIncreasing = 1 / ($self->{mid} - $self->{low});
my $mDecreasing = -1 / ($self->{high} - $self->{mid});
# reject values that are "out of bounds"
return ($membership = 0)
if ($value <= $self->{low} ) or ($value >= $self->{high} );
# now calculate membership:
# y=mx+b , just like in algebra
if ($value < $self->{mid}) {
$membership = ($value - $self->{low}) * $mIncreasing;
} elsif ($value == $self->{mid}) {
$membership = 1;
} else {
$membership = (($value - $self->{mid}) * $mDecreasing) + 1;
}
return $membership;
}
sub range {
# returns the distance from one endpoint to the other
my ($self) = @_;
return abs( $self->{high} - $self->{low} );
}
1;
lib/AI/Fuzzy/Set.pm view on Meta::CPAN
package AI::Fuzzy::Set;
## Fuzzy Set ####
sub new {
my $class = shift;
my $self = {} ;
# accepts a hash of member weights..
# ( $members{$member}=$weight )
%{$self->{members}} = @_;
bless $self, $class;
}
sub membership {
# naturally, it returns a fuzzy value - the degree
# to wich $item is a member of the set! :)
my $self = shift;
my $item = shift;
if (defined(${$self->{members}}{$item})) {
return ${$self->{members}}{$item};
} else {
return 0;
}
}
sub members {
# returns list of members, sorted from least membership to greatest
my $self = shift;
my %l = %{$self->{members}};
return sort { $l{$a} <=> $l{$b} } keys %l;
}
sub equal {
# returns true if the argument set is equal to this one
my $self = shift;
my $otherset = shift;
my (%us, %them);
%us = %{$self->{members}} if (exists $self->{members});
%them = %{$otherset->{members}} if (exists $otherset->{members});
# for all keys in us and them
foreach my $key (keys (%us), keys (%them)) {
# not equal if either set is missing a key
return 0 unless (exists ($us{$key}) && exists ($them{$key}) );
# not equal if the membership of the keys isn't equal
return 0 unless (float_equal($us{$key},$them{$key}, 10));
}
# otherwise they are equal
return 1;
}
sub union {
# returns a set that is the union of us and the argument set
my $self = shift;
my $otherset = shift;
my (%us, %them, %new);
%us = %{$self->{members}} if (exists $self->{members});
%them = %{$otherset->{members}} if (exists $otherset->{members});
# for all keys in us and them
foreach my $key (keys (%us), keys (%them)) {
if (not exists $us{$key} and exists $them{$key}) {
$new{$key} = $them{$key};
next;
}
if (not exists $them{$key} and exists $us{$key}) {
$new{$key} = $us{$key};
next;
}
if ($us{$key} >= $them{$key}) {
$new{$key} = $us{$key};
} else {
$new{$key} = $them{$key};
}
}
return new AI::Fuzzy::Set(%new);
}
sub intersection {
# returns a set that is the intersection of us and the argument set
my $self = shift;
my $otherset = shift;
my (%us, %them, %new);
%us = %{$self->{members}} if (exists $self->{members});
%them = %{$otherset->{members}} if (exists $otherset->{members});
# for all keys in us and them
foreach my $key (keys (%us), keys (%them)) {
if (not exists $us{$key} or not exists $them{$key}) {
$new{$key} = 0;
next;
}
if ($us{$key} <= $them{$key}) {
$new{$key} = $us{$key};
} else {
$new{$key} = $them{$key};
}
}
return new AI::Fuzzy::Set(%new);
}
sub complement {
# returns a set that is the complement of us
# requires that the set contain values from 0 to 1
my $self = shift;
my (%new);
foreach my $member ($self->members) {
my $comp = 1 - $self->membership($member);
return undef if ($comp < 0 || $comp >1);
$new{$member} = $comp;
}
return new AI::Fuzzy::Set(%new);
}
sub support {
# returns the support set.
# defined as the set of all elements in our set with a non-zero membership.
my $self = shift;
my (%support);
foreach my $member ($self->members) {
$support{$member}++ if ($self->membership($member) != 0);
}
return new AI::Fuzzy::Set(%support);
}
sub core {
# returns the core set.
# defined as the set of all elements in our set with full membership
my $self = shift;
my (%core);
foreach my $member ($self->members) {
$core{$member}++ if ($self->membership($member) == 1);
}
return new AI::Fuzzy::Set(%core);
}
sub height {
# returns the height of the set
# defined as the maximal membership value in our set
my $self = shift;
my ($max) = 0;
foreach my $member ($self->members) {
$max = $self->membership($member) if ($self->membership($member) > $max);
}
return $max;
}
sub is_normal {
# Logical return
# normal is defined as a set with a height of 1
my $self = shift;
return 1 if ($self->height == 1);
return 0;
}
sub is_subnormal {
# Logical return
# normal is defined as a set with a height less than 1
my $self = shift;
return 1 if ($self->height < 1);
return 0;
}
sub as_string {
my $self = shift;
my @members;
foreach my $member ($self->members) {
push (@members, "$member/" . $self->membership($member) );
}
return join(', ', @members);
}
sub float_equal {
my ($A, $B, $dp) = @_;
# print sprintf("%.${dp}g", $A). " eq " . sprintf("%.${dp}g", $B) . "\n";
return sprintf("%.${dp}g", $A) eq sprintf("%.${dp}g", $B);
}
1;
use Test;
BEGIN { plan tests => 17 };
use AI::Fuzzy;
ok(1); # If we made it this far, we're ok.
$l = new AI::Fuzzy::Label;
ok(2); # If we made it this far, we're ok.
$s = new AI::Fuzzy::Set;
ok(3); # If we made it this far, we're ok.
$a = new AI::Fuzzy::Axis;
ok(4); # If we made it this far, we're ok.
$a->addlabel("baby", -1, 1, 2.5);
$a->addlabel("toddler", 1, 1.5, 3.5);
$a->addlabel("little kid", 2, 7, 12);
$a->addlabel("kid", 6, 10, 14);
$a->addlabel("teenager", 12, 16, 20);
$a->addlabel("young adult", 18, 27, 35);
$a->addlabel("adult", 25, 50, 75);
$a->addlabel("senior", 60, 80, 110);
$a->addlabel("relic", 100, 150, 200);
ok($a->labelvalue(50)->name, "adult");
ok($a->labelvalue(5)->name, "little kid");
$fs_tall_people = new AI::Fuzzy::Set( Lester=>34, Bob=>100, Max=>86 );
# $x will be 86
$x = $fs_tall_people->membership( "Max" );
ok($x, 86);
# get list of members, sorted from least membership to greatest:
@shortest_first = $fs_tall_people->members();
ok @shortest_first, 3, "got " . join(',', @shortest_first) . ", wanted " . join(',', qw(Lester Max Bob));
$a1 = new AI::Fuzzy::Axis;
$a1->addlabel( "cold", 32, 60, 70 );
$a1->addlabel( "warm", 60, 70, 90 );
$a1->addlabel( "hot", 77, 80, 100 );
# what I consider hot. :) (in Farenheit, of course!)
ok $a1;
$a = $a1->applicability(99,"hot");
# $a is now the degree to which $label applies to $value
ok $a;
$l = $a1->labelvalue(99);
# applies a label to $value
ok ($l->name, "hot");
@l = $a1->labelvalue(65);
%l = $a1->labelvalue(65);
# returns a list of labels and their applicability values
ok @l, 4, "got " . join (',',@l) . " wanted " . join(',',qw(cold 0.5 warm 0.5));
ok ($l{cold}, .5);
ok ($l{warm}, .5);
$ns = new AI::Fuzzy::Set( Lester=>.34, Bob=>1.00, Max=>.86 );
$sa = new AI::Fuzzy::Set( Lester=>.34, Bob=>1.00, Max=>.86 );
$sb = new AI::Fuzzy::Set( Bob=>1.00, Max=>.86 );
$sc = new AI::Fuzzy::Set( Lester=>.35, Bob=>1.00, Max=>.86 );
ok ($sa->equal($ns),1);
ok ($sa->equal($sc),0);
ok ($sa->equal($sb),0);
ok ($sa->equal($sa),1);
$sd = $sa->union($sc);
ok ($sd->membership("Lester"), .35);
$sd = $sa->intersection($sb);
ok ($sd->membership("Lester"), 0);
$sd = $sd->complement();
ok ($sd->membership("Max"), .14);
# the complement of the complement should be the original
$se = $sa->complement() || print "problem with complement\n";
$se = $se->complement() || print "problem with complement\n";
ok ($se->equal($sa));
# a union b should equal b union a
$aUb = $sa->union($sb);
$bUa = $sb->union($sa);
ok($aUb->equal($bUa));
# a intersection b should equal b intersection a
$aNb = $sa->intersection($sb);
$bNa = $sb->intersection($sa);
ok($aNb->equal($bNa));
# a union b union c should equal b union c union a
$abc = $sa->union($sb);
$abc = $abc->union($sc);
$bca = $sb->union($sc);
$bca = $bca->union($sa);
ok($abc->equal($bca));
# a intersection b intersection c should equal b intersection c intersection a
$abc = $sa->intersection($sb);
$abc = $abc->intersection($sc);
$bca = $sb->intersection($sc);
$bca = $bca->intersection($sa);
ok($abc->equal($bca));
# comment this to run extra output tests.
#exit 0;
$a = new AI::Fuzzy::Set( x1 => .3, x2 => .5, x3 => .8, x4 => 0, x5 => 1);
$b = new AI::Fuzzy::Set( x5 => .3, x6 => .5, x7 => .8, x8 => 0, x9 => 1);
print "a is: " . $a->as_string . "\n";
print "b is: " . $b->as_string . "\n";
print "a is equal to b" if ($a->equal($b));
$c = $a->complement();
print "complement of a is: " . $c->as_string . "\n";
$c = $a->union($b);
print "a union b is: " . $c->as_string . "\n";
$c = $a->intersection($b);
print "a intersection b is: " . $c->as_string . "\n";
#---------- test < and > -----
$f = new AI::Fuzzy::Axis;
$f->addlabel("baby", -1, 1, 2.5);
$f->addlabel("toddler", 1, 1.5, 3.5);
$f->addlabel("little kid", 2, 7, 12);
$f->addlabel("kid", 6, 10, 14);
$f->addlabel("teenager", 12, 16, 20);
$f->addlabel("young adult", 11, 27, 35);
$f->addlabel("adult", 25, 50, 75);
$f->addlabel("senior", 60, 80, 110);
$f->addlabel("relic", 100, 150, 200);
my ($a, $b) = ($f->label("baby"), $f->label("toddler") );
if ($a->lessthan($b) ) {
print "baby < toddler\n";
} else {
print "baby !< toddler\n";
}
($a, $b) = ($f->label("baby"), $f->label("toddler") );
if ($a->greaterthan($b) ) {
print "baby > toddler\n";
} else {
print "baby !> toddler\n";
}
($a, $b) = ($f->label("relic"), $f->label("toddler") );
($a->greaterthan($b) ) ? ( print "relic > toddler\n" ) : ( print "relic !> toddler\n" );
# these are a strange case ...
($f->greaterthan("teenager", "young adult") ) ?
( print "teenager > young adult\n" ) : ( print "teenager !> young adult\n" );
($f->lessthan("teenager", "young adult") ) ?
( print "teenager < young adult\n" ) : ( print "teenager !< young adult\n" );
($f->between("toddler", "little kid", "baby") ) ?
( print "toddler is between little kid and baby\n" ) : ( print "toddler is not between little kid and baby\n" );
($f->between("adult", "little kid", "baby") ) ?
( print "adult is between little kid and baby\n" ) : ( print "adult is not between little kid and baby\n" );
view release on metacpan - search on metacpan
( run in 1.560 second using v1.00-cache-2.02-grep-82fe00e-cpan-72ae3ad1e6da )