File Coverage

blib/lib/AI/FuzzyLogic.pm

Criterion	Covered	Total	%
statement	34	319	10.6
branch	0	116	0.0
condition	0	18	0.0
subroutine	12	94	12.7
pod	7	42	16.6
total	53	589	9.0

package AI::FuzzyLogic;

# hi! reading through the code? i try to get the infrastructure stuff out of the
# way first, so it is boring for a while. search for the string "conversion"
# below to find the start of the meat. "operators" follows quickly after.
# unary operators come first, then binary. this is where the guts of this implementation
# of fuzzy logic are. if you're looking for infrastructure, accessors and constructurs
# and such come first, and for anything more complex, i suggest you read the ntoes
# at the end of the file. i've tried to comment and document well, but please
# let me know if something could be improved. good luck!

=head1 NAME

AI::FuzzyLogic - Fuzzy Set Operations and Tools

=head1 SYNOPSIS

  use AI::FuzzyLogic;

  $i = new AI::FuzzyLogic $unittype, @numbers;          # new set with one subset
  $i = new AI::FuzzyLogic 'age', 0, 0.1, 0.2, 0.1, 0;   # same thing

  $i = new AI::FuzzyLogic $subset1, $subset2, $subset3; # new set with several subsets

  # another syntax for building a set with several subsets:
  $i = AI::FuzzyLogic->new(
       AI::FuzzyLogic->new('distance', 0.0, 0.1, 0.1, 0.5, 0.8, 0.6, 0.3, 0.0),
       AI::FuzzyLogic->new('time',     0.3, 0.3, 0.1, 0.1, 0.1, 0.2, 0.3, 0.3),
       AI::FuzzyLogic->new('heat',     0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.2),
  );

  # constructors for explicit combinational behavior:
  $i = new AI::FuzzyLogic::Correlator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Permutator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Discriminator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Abstractor 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;

  # change combinational behavior:
  $set->as_correlator();      # operations work on matching subsets of same type
  $set->as_permutator();      # operations work across all subsets of each set
  $set->as_discriminator();   # operations best matching subset from right for each on left
  $set->as_abstractor();      # operations return one set with one subset summerizing fit

  $i->add_subsets($j);        # combine subsets or other sets in

  abs($i)                     # defuzzify to integer (centroid - curve middle, x axis)
  0+$i                        # defuzzify to integer (mean - average curve height, y axis)

  $a & $b                     # intersection of sets
  $a | $b                     # union of sets
  $i++                        # normalize curve to 1.0
  $i--                        # stretch curve to edges
  ~$i                         # negate set
  $i ** 0.5                   # dialation
  "$i"                        # convert subsets to ASCII graphs

  $a + $b                     # sum sets
  $a - $b                     # subtract sets
  $a * $b                     # multiply sets - useful for sensitivity control
  $a / $b                     # divide sets - useful for sensitivity control

  $h->larger($a)              # boolean: does $h completely encompass $a?

  $a ^ $b                     # xor: same as ~($a | $b)
  $a < $b                     # compare volume: is $a smaller?
  $a > $b                     # compare volume: is $a larger?

  @sets = $a->unwrap();              # get subsets as list of AI::FuzzyLogic::Subset objects
  @sets = $a->query_type('type');    # get subsets of type 'type' as a list of AI::FuzzyLogic::Subset objects
  $a->change_type('fromtype', 'to'); # change type of subsets of type 'fromtype' to 'to'

=head1 DESCRIPTION

Performs all basic operations on Fuzzy Sets. Use English-like, intentionally
vague objects representing concepts with which to make inferences. The inferences might be approximate
reasoning about precise knowledge, or precise reasoning about approximate knowledge. This
vagueness allows the capture and application of human expert knowledge.

Overloads Perl operators to perform operations on Fuzzy Sets.

=head2 Other Fuzzy Modules

L and L appear to better supported and more mature modules.

=head2 How AI::FuzzyLogic is Different

It doesn't attempt to provide a structure for building
inference chains - that is left to regular Perl code using overloaded operators, C
statements, and the like.
So, a major feature is the operator overloading and that interface.

We also define a larg set of operations, introduce sets-of-sets
and combinational, permutational behavior for working on them.

Extensible framework. Modules in this distribution may be subclassed to define new
Fuzzy operations, combinational behaviors, and other features. Extensions may be
added to this distribute (if I like them), or you may distribute them seperately,
with this module as a dependency.

=head2 Terminology

This is not standard Fuzzy Logic terminology but instead lingo used in this module.
Sets (AI::FuzzyLogic) contain subsets (AI::FuzzyLogic::Subset). Subsets contains elements.
Elements are just numbers in an array (this implementation may change, but it is useful
to think of it this way).
Elements are also called segments sometimes, as in segments in a LED display.
Combinational Behavior controls what happens when an operation is performed
between two sets, one or both of which have more than one subset.

=head2 Methods

These public methods expose parts of the interface that aren't available through the
overloaded syntax. The overloaded syntax is of course the ability to use Perl built
in operators on Fuzzy sets and have Fuzzy operations performed.

=cut

our $VERSION='0.06';

use strict;
use warnings;

use English::Reference;
use Scalar::Util 'blessed';

use AI::FuzzyLogic::Subset;

#
# terminology
#

# *_inner routines are logic defined as part of the subset. for example, to compare the
# mean of the curves of two subsets, each subset would be asked for its mean, then those
# numbers would be compared.

#
# debugging
#

use lib '/home/projects/transient';
#use Nark;
#Nark::nark sub { print shift()."\n" };

$SIG{__DIE__} =  $SIG{INT} = sub {
   # help us locate endless loops.... testing.
   # when someone does kill -INT  from the command line, dump our stack and exit
   print STDERR shift, map { (caller($_))[0] ? sprintf("%s at line %d\n", (caller($_))[1,2]) : ''; } 0..30;
   print STDERR join "\n", @_;
   exit 1;
};

#
# overload
#

# if $_[2] is true, it means that the arguments order was swapped so that
# the object reference would come first. this way, the first two args
# to us are the args to operation that was overloaded, except that the
# overloaded object always comes first in cases where an operation is being
# performed against both an overloaded object and a regular number.

sub objify {

  # if $_[2], then reverse the args.
  # if one of the args isn't an object, create it as a new us.
  # new objects created from numbers are sets with a single subset with that number repeated
  # across three elements.
  # this wraps our internal overloaded methods. our return value is fed directly to them.

  @_ = ($_[1], $_[0]) if $_[2];

  @_ = ($_[0], (__PACKAGE__->new('unknown', ($_[1]) x 3))) if ! ref $_[1];

  return @_;

}

use overload
'&'	=>	sub { band(objify(@_)); },      # set intersection (min)
'|'	=>	sub { bior(objify(@_)); },      # set union (max)
'^'	=>	sub { bxor(objify(@_)); },      # set xor ;)
'+'	=>	sub { $_[2] && !$_[1] ? numify2($_[0]) : badd(objify(@_)); },
                                                # set summation, or if 0+, defuzzification
'0+'    =>      sub { numify2(@_) },            # defuzzify - mean
'abs'	=>	sub { numify(@_) },             # defuzzify - centroid
'-'	=>	sub { bsub(objify(@_)); },      # set difference
'*'	=>	sub { bmul(objify(@_)); },      # set multiply
'/'	=>	sub { bdiv(objify(@_)); },      # set divide
'neg'	=>	sub { bneg(objify(@_)); },      # opposite - invert set
'~'	=>	sub { bneg(objify(@_)); },      # opposite - invert set
'**'	=>	sub { bpow(@_); },              # dialation (2nd arg must be number)
'<'     =>      sub { bles(objify(@_)); },      # which has less area?
'>'     =>      sub { bgre(objify(@_)); },      # which has more area?
'""'    =>      sub { stringify(@_) },          # make pretty little charts
'%'	=>	sub { bmod(objify(@_)); },      # undef - how many times does one set fit in another?
'<<'	=>	sub { brsh(objify(@_)); },      # undef
'>>'	=>	sub { blsh(objify(@_)); },      # undef
'<=>'	=>	sub { bcmp(objify(@_)); },      # compare volume
'cmp'	=>	sub { bstrcmp(objify(@_)); },   # compare center-of-mass
'bool'  =>      sub { numify2(@_); };           # is this set "true"?

# XXX is this todo or what? suggestions for operations?
# min: turn a set into a singleton based on highest point or center of mass or something. defuz.
# max: normalize the set to exist from 0.0 to 1.0. regenerate sets that got beat down.

#
# constructors
#

=head3 new

C comes in two basic forms.

Create a new set, with exactly one subset, from raw input data:

  $i = new FuzzyLogic $unittype, @numbers;          # new set with one subset
  $i = new FuzzyLogic 'age', 0, 0.1, 0.2, 0.1, 0;   # same thing

Create a new set, with potentially many subsets, from several existing subsets.

  $i = new FuzzyLogic $subset1, $subset2, $subset3; # new set with several subsets

Subsets can be obtained form existing sets using the C method:

  $i = new FuzzyLogic $set1->unwrap(), $set2->unwrap();

C may return any number of subsets.

Though the module will extract the subsets from sets should sets be passed to
the constructor. This is like perl arrays - combining arrays flattens them
all into one large one. No, there is no equivilent to references. See the
L for another note on this.

AI::FuzzyLogic::Abstractor is the default type of new objects. If something else
is desired, it should be specified explicitly, as the default is likely to change
in future versions.

  # constructors for explicit combinational behavior:
  $i = new AI::FuzzyLogic::Correlator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Permutator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Discriminator 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;
  $i = new AI::FuzzyLogic::Abstractor 'speed', 0.1, 0.3, 0.2, 0.1, 0.1;

Beware! Once created, you'll need to change the combinational behavior frequently
to get any work done. Use the C, C,
C, and C methods to change the type of an
existing object.

=cut

sub new {

  my $class = shift; $class = ref $class if ref $class;

  $class = 'AI::FuzzyLogic::Abstractor' if $class eq 'AI::FuzzyLogic'; # default to this subclass

  my $self = bless [], $class;

  $self->add_subsets(@_);

  $self;

}

#
# accessors
#

=head3 add_subsets

Just like C, but adds new subsets to an existing set.

  $set->add_subsets(new AI::FuzzyLogic 'foo', 0.0, 0.1, 0.1, 0.1, 0.0);

Newly added subsets retain their type in the new object (though the output of
an operation against an Abstractor is always a single set of type 'abstract').

C calls this method to do its dirty work.

=cut

sub add_subsets {

  # AI::FuzzyLogic objects are containers of AI::FuzzyLogic::Subset objects.
  # this method adds a new AI::FuzzyLogic::Subset object to our list.
  # it may have to create one first, if all of the args are numeric.
  # if any of the arguments are AI::FuzzyLogic objects, we must extract the subsets from it.
  # if we get an array ref, we bless it into a new AI::FuzzyLogic::Subset.
  # if any given arg is already an AI::FuzzyLogic::Subset, we add it directly to our list.
  # new() uses this to make sense of its arguments, and it is available for use directly as well.

  my $me = shift;

  if(! grep ref $_, @_ ) {
    # they're all non-reference types
    # print "debug: ", scalar grep({ ! ref $_ } @_), " and ", scalar(@_), "\n";
    my $type = shift or die "add_subsets() all non reference case - expecting type string as first arg";
    push @$me, AI::FuzzyLogic::Subset->new($type, [@_]);
    return $me;
  }

  foreach my $i (@_) {

    push @$me, $i if blessed($i) and $i->isa('AI::FuzzyLogic::Subset');
    push @$me, $i->unwrap() if blessed($i) and $i->isa('AI::FuzzyLogic');
    push @$me, AI::FuzzyLogic::Subset->new('unknown', [map { $_ } @$i]) if ref $i eq 'ARRAY';

  }

  return $me;

}

*add_subset = *add = *add_subsets;

sub import { return 1; }

=head3 query_type

  $set->query_type('speed');

Return the subsets (AI::FuzzyLogic::Subset objects) of a given type ('speed', in
this example. In scalar context, the first is returned. In list context, all
matching subsets are returned. This allows access to subsets directly minipulate
them. This can be used with the constructor to build a new AI::FuzzyLogic object
containing all subsets of a given type:

  $speeds = new AI::FuzzyLogic $old_set->query_type('speed');

Returns C if none are found.

=cut

sub query_type {

  my $me = shift;
  my $type = shift;

  my @sets = grep { $_->type() eq $type } ARRAY $me;
  return @sets if wantarray();
  return $sets[0] if @sets;
  return undef;

}

=head3 unwrap

  @subsets = $set->unwrap();

Return all subsets from a set. These may be used to construct new sets, or
they may be individually minipulated (type changed, perhaps). Some
operators mutate (change the existing object) while others return new
objects that reflect the changes. The former case will affect the state of
the set from which the subset was obtained, and the latter won't.

Handy for debugging:

  foreach my $i ($set->unwrap()) {
    print "in set: ", $i->type(), "\n";
  }

Subsets also have an C method that returns an array of scalar
floating point values that describe the set.


=cut

sub unwrap {

  # all of our little Subsets
  # currently, this object is a blessed arrayref, where each element is a subset.
  # this may change in the future. for now, all we have to do is reference ourselves
  # to get our list of subsets.
  # it has come to my attention that this needs to be used far too often to do
  # routine work. attempting to fix API.

  my $me = shift;

  return ARRAY $me;

}

sub set {
    my $me = shift;
    # 2007 new
    return $me->[0]->set;
}

sub name {
    my $me = shift;
    # 2007 new
    return $me->[0]->name;
}

sub type {
    my $me = shift;
    # 2007 bugfix for documentation... using this method won't make sense in a lot of cases but should right after a discriminator operation or abstractor operation where there's one set left
    return $me->[0]->type;
}

sub subtypes {

  # we have an as_... method for each of our subtypes. each subtype adds its own as_...
  # method to the base class. these methods rebless the object, changing it from one
  # subtype to another. since they are put into the base class, any subtype cass be
  # converted to any other subtype by calling the right as_... method.
  # this method looks through the symbol table to find out which as_... methods have
  # actually been added, and returns the list of names of them.

  grep { m/^as_/ } keys %{__PACKAGE__.'::'};

}

=head3 change_type

  $bar->change_type('abstract', 'foo'); # change result from "abstract" to "foo" type

To make the combinational magic specified by Combinational Behavior work, types
must match up. This means frequently having to change the type of a subset in a set.
Volts may go to ampres to watts, and will need to be renamed at each step. If
sets with only one subset are used, it may be easier to just make all sets into
Permutators:

  my $juice = AI::FuzzyLogic::new('juice', 0.5, 0.5, 0.5)->as_permutator();

This, and the result of all operations on which it is on the left hand side of,
will all combine freely with other types. Otherwise, you'd eventually have
to do:

  $juice->change_type('juice', 'watts');

Beware! Type is completely different than combinational behavior. Type
controls how things combine, but the rules ultimately depend on
the combinational behavior of the object on the left of the operation.
Start with the description of the combinational behavior (Abstractor,
Permutator, Discriminator, Correlator) and read how it uses type
information.

=cut

sub change_type {

  # change subsets of one type to another type. this is often required
  # to control combinational behavior.

  my $me = shift;
  my $oldtype = shift() or die "old type (string) required";
  my $newtype = shift() or die "new type (string) required";
  my $count = 0;

  foreach my $i (ARRAY $me) {
    if($i->type() eq $oldtype) {
      $i->type($newtype);
      $count++;
    }
  }

  return $count;

}

#
# conversion
#

sub stringify {

  # generate pretty little text graph for each subset in our collection
  # part of overload interface to the world - attempting to convert to string
  # and print a fuzzy object makes the overload interface call this.
  # using a fuzzy object with the . operator or using it inside of a "" string
  # triggers this.

  my $me = shift;

  my $ret;

  foreach my $subset (ARRAY $me) {
    $ret .= $subset->stringify();
  }

  return $ret;

}

sub numify {

  # find the center of mass of the curve for each set.
  # part of overload interface to the world.
  # this isn't a meaningful operation for sets that contain more than one subset -
  # things kind of get combined in a non-helpful way.
  # using other operations, distill all of the data down to single sets,
  # then use this to do "crisp" poerations between this distilled data.
  # fuzzy data must be made crisp at some point if it is to be used in non
  # fuzzy systems. it can be done by converting it to a number, or doing some
  # test between two fuzzy sets that yeilds a yes/no answer.

  # comments to self:

  # this doesn't make any sense, using centroid_inner(). changes to mean_inner().
  # centroid is a function of left-rightness. unless all subsets describe the same thing,
  # this is meaningless. if requesting a number, the user is probably interested in overall fit,
  # which would mean just average of each set, all averaged together.

  # this doesn't make sense averaging the subsets volumes. if the correlator fails to find
  # matching subset types, something could actually rank higher than a case where all subtimes
  # match up. better to sum the averages.

  # more comments to self:

  # duh, it does make sense. people need two means of defuzzifying: centroid and mean.
  # centroid does left-right, mean does up-down.

  my $me = shift;

  my $total;

  #if(scalar ARRAY $me > 1) {
  #  warn "Attempting to convert fuzzy subsets to a number: which subset do you want? Use a " .
  #       "discriminator to select only one.";
  #  return 0;
  #}

  foreach my $subset (ARRAY $me) {
    $total += $subset->centroid_inner();
  }

  return undef unless $total;

  return $total / scalar ARRAY $me;

}

sub numify2 {
  my $me = shift;
  my $total;
  foreach my $subset (ARRAY $me) {
    $total += $subset->mean_inner();
  }
  return undef unless $total;
  return $total / scalar ARRAY $me;
}

#
# operators
#

# the fuzzy operations that can be performed defines fuzzy logic, and is the heart of this
# module. unary operators are delegated to the subset itself. binary operators are
# done here. the definition of the actual operation is here, but a lot of infrastructure
# is called upon.

#
# unary operations
#

# each of these creates a new AI::FuzzyLogic object of the same subtype as the current
# object, containing the result of applying the operation to each subset in the current object.
# the results of applying these operations should all be copies, not references to originals.

sub bneg { $_[0]->new(map({ $_->bneg() } ARRAY $_[0])) }
sub bpls { $_[0]->new(map({ $_->bpls() } ARRAY $_[0])) }
sub bpow { $_[0]->new(map({ $_->bpow() } ARRAY $_[0])) }
sub bmns { $_[0]->new(map({ $_->bmns() } ARRAY $_[0])) }
sub brsh { $_[0]->new(map({ $_->brsh() } ARRAY $_[0])) }
sub blsh { $_[0]->new(map({ $_->blsh() } ARRAY $_[0])) }

# except this one, which is a mutator, and changes the originals.

sub balance { foreach my $subset (ARRAY $_[0]) { $subset->balance() }; $_[0]; }

#
# utilities for use by binary operators
#

sub compile {

  # given two subsets and a callback, callback with each set of paired numbers inside those subsets.
  # this stretches out the smaller set to be as large as the larger set, for the purpose of doing
  # element-by-element comparisons.

  # see the notes at the end of this file on how this fits in.

  my $inta = shift; die 'wtf' unless $inta->isa('AI::FuzzyLogic::Subset');
  my $intb = shift; die 'wtf' unless $intb->isa('AI::FuzzyLogic::Subset');

  my $callback = shift;

  my $seta = $inta->set() or die;
  my $setb = $intb->set() or die;

  my $stepa; my $stepb; my $max;
  my $posa = 0; my $posb = 0;
  my @ret;

  if(scalar(ARRAY $seta) > scalar(ARRAY $setb)) {
    $max = scalar(ARRAY $seta); $stepa = 1; $stepb = scalar(ARRAY $setb)/scalar(ARRAY $seta);
  } else {
    $max = scalar(ARRAY $setb); $stepb = 1; $stepa = scalar(ARRAY $seta)/scalar(ARRAY $setb);
  }

  while($posa<$max && $posb<$max) {
    $seta->[int $posa] ||= 0; # work around for a strange bug that generates warnings XXX
    $setb->[int $posb] ||= 0; # work around for a strange bug that generates warnings XXX
    push @ret, $callback->($seta->[int $posa], $setb->[int $posb]);
    $posa += $stepa; $posb += $stepb;
  }

  return AI::FuzzyLogic::Subset->new($inta->type() || 'unknown', \@ret);

}

#
# binary operators - discriminators
#

# part of each of these are stock. see the comments at the end of the file about
# using selector() to narrow down which subsets should be combined, and compile()
# to do an element by element comparison between those two subsets.
# just pay attention to the line that starts with "return" - that is the heart
# of each operation, which is applied to each matching element between two subsetsw.

#head3 best
#
#When used with Permutators, the best combination of subsets from the left and
#right is found. With Abstractors, you get a single output set representing
#the best combination. Perhaps most useful with the Descriminator, with one
#or two or many subsets in the set on the left and several on the right.
#The best match is found and the subset on the right returned in a new AI::FuzzyLogic object.
#
#  $a->best($b);
#
#Right now, I don't think these work. Everything is included in the output, though
#some subsets are mangled to all-zeros or otherwise molested.
#
#cut

sub best {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # $_[0] vs $_[1] ---- more points, the closer together each point
      # how closely do two lines follow each other? like smallest() and largest() but without
      # the "flunk" conditions for going over or under.
      return 1.0 - abs($_[0] - $_[1]);
    });
  });
}

sub smallest {
  my $me = shift;
  $me->selector(shift(), sub {
    my $flunk = 0;
    my $subset = compile($_[0], $_[1], sub {
      # more points the closer each $_[0]->[x] is without going over $_[1]->[x]
      # ie, the smaller one line is, the better. if it goes over, it flunks.
      # 0 condition should 0 entire set, not just that segment - XXX
      return (1 - ($_[1] - $_[0])) if $_[0] < $_[1];
      $flunk = 1; return 0;
    });
    return $flunk ? AI::FuzzyLogic::Subset->new($_[0]->type(), [0, 0, 0, 0, 0]) : $subset;
  });
}

sub largest {
  my $me = shift;
  $me->selector(shift(), sub {
    my $flunk = 0;
    my $subset = compile($_[0], $_[1], sub {
      # more point the closer each $_[0]->[x] is without going under $_[1]->[x]
      # ie, larger the better, and cannot go under the second line.
      # 0 condition should 0 entire set, not just that segment - XXX
      return (1 - ($_[0] - $_[1])) if $_[0] > $_[1];
      $flunk = 1; return 0;
    });
    return $flunk ? AI::FuzzyLogic::Subset->new($_[0]->type(), [0, 0, 0, 0, 0]) : $subset;
  });
}

=head3 larger

  $a->larger($b); # does $a completely encompass $b?

Test if one set fits entirely within another or not. If there are multiple subsets
and combinational behavior and types allow, then it returns true if any matching
subsets on the left are larger than any on the right.

Unlike the above, this is actually beleived to work and has been somewhat tested.

=cut

sub larger {
  my $me = shift;
  my $larger = 1;
  my $any = 0;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # the left side must entirely contain the right side to return true
      $any = 1;
      $larger = 0 if $_[0] < $_[1];
      return 0;
    });
  });
  $any or die "no matching subtypes for object type " . ref($me);
  return $larger;
}

sub centroid {
  my $me = shift;
  $me->selector(shift(), sub {
    # how different is the center of mass between two lines? the lines might have very different
    # height and shape, but if their center of masses match exactly, we get a 1.0
    return abs(centroid_inner($_[0]) - centroid_inner($_[1]));
  });
}

#
# binary operators - operators
#

sub bmul {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # good for sensitivity control - amplify the importantance of some regions
      return $_[0] * $_[1] > 1 ? 1 : $_[0] * $_[1];
    });
  });
}

sub bdiv {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # good for sensitivity control - dimenish the importantance of some regions
      return $_[0] / $_[1];
    });
  });
}

sub badd {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      return $_[0]+$_[1] > 1 ? 1 : $_[0]+$_[1];
    });
  });
}

sub bsub {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      return $_[0]-$_[1] > 0  ? $_[0]-$_[1] : 0;
    });
  });
}

sub bcmp {
  # compare volumes, to sort by largeness of set
  my $me = shift(); $me->isa(__PACKAGE__) or die __PACKAGE__ . ' required';
  my $them = shift()->numify(); $me->isa(__PACKAGE__) or die __PACKAGE__ . 'required';
  return $me->numify2() <=> $them->numify2();
}

sub bstrcmp {
  # compare center of mass, to sort by position of hump (okey, that sounds bad)
  my $me = shift(); $me->isa(__PACKAGE__) or die __PACKAGE__ . ' required';
  my $them = shift()->numify(); $me->isa(__PACKAGE__) or die __PACKAGE__ . 'required';
  return $me->numify() <=> $them->numify();
}

sub band {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # the quentiscential fuzzy operation - intersection
      return $_[0] < $_[1] ? $_[0] : $_[1];
    });
  });
}

sub bior {
  my $me = shift;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      return $_[0] > $_[1] ? $_[0] : $_[1];
    });
  });
}

sub bxor {
  my $me = shift;
  my $max;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # the degree that neither are true. same as an or then a negate, i guess.
      return 1.0 - ( $_[0] > $_[1] ? $_[0] : $_[1] );
    });
  });
}

sub bles {
  my $me = shift;
  my $lhs; my $rhs;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # does the first set have less area then the second? returns an integer.
      # this implementation works - compile() stretches one out as needed.
      $lhs += $_[0]; $rhs += $_[1];
      return 0;
    });
  });
  return $lhs < $rhs;
}

sub bgre {
  my $me = shift;
  my $lhs = 0; my $rhs = 0;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      $lhs += $_[0]; $rhs += $_[1];
      return 0;
    });
  });
  return $lhs > $rhs;
}

sub bmod {
  my $me = shift;
  my $minfactor = undef;
  $me->selector(shift(), sub {
    compile($_[0], $_[1], sub {
      # how many times does the set on the right fit into set on the left, for the smallest
      # segment? untested.
      my $tmp;
      if($_[1]) {
        $tmp = $_[0] % $_[1];
        $minfactor = $tmp if ! defined $minfactor;
        $minfactor = $tmp if $tmp < $minfactor;
      } else {
        # zero fits in an infinte number of times, even to zero. increase but don't decrease.
        $minfactor = 10 if ! defined $minfactor;
      }
      return 0;
    });
  });
  return $minfactor;
}

1;

#
# subclasses of AI::FuzzyLogic -
# versions of ourselves have different combinational behaviors
#

# the base AI::FuzzyLogic set is never used directly. all sets are really a
# subclass. each subclass adds an as_* method to the base class, AI::FuzzyLogic,
# and each subclass defines its own private selector() method. this selector()
# method is the key difference between each subclass type, and it controls
# how subsets are permutated when two sets are compared against each other.
# read the POD that describes each behavior to understand the purpose of these
# subclasses. see the section about "Combinational Behavior".
# selector() is called from all "binary operators" - operators that require
# two arguments, one on the left, and one on the right. this is part of the
# overload interface. perl invokes the correct routine to deal with an operator
# being used on a fuzzy object. there is also a high level explanation at the
# end of the file, of how operators and selectors and subsets fit together.

=head2 Combinational Behavior

A set contains subsets. How the subsets of two sets interact when an operation is
performed is their combination behavior. Depending on what the data means and
how you're using it, you'll need to specify how things combine.

=head3 Abstractors

Abstractors always return exactly one set, which is meant to be a gross summary
of membership of one set in another.
Returns one set, with about as many members as there are subsets in the object on
the right. Gives a membership summery, or a composition of how well
or how poorly all of the various attributes match up, by type.
If the types don't match up, they are ignored. Otherwise, the comparision
of the matching sets forms a single segment in the output set. The
output set is balanced, with the line the highest in the center.
Useful when used between a set containing patterns to match and set containing
observations.

For example, subsets may represent color and size. One set, "a", is observed
in the wild (the Internet, through data capture, what have you). Other sets,
"x1", "x2", "x3", etc, each having the same subsets (color and size) are compared
against "a" to find the best match in attempt to classify "a" as being
stereotypical of one of a few known cases.

If the output is a flat zeros, no criteria matched. If it is a low curve,
few things matched, and they matched poorly. If it is a low curve with
some spikes in the middle, a few things matched well, but most criteria
matched poorly. A nice bell curve is a fairly good match on most criteria,
and a solid box with 1's across the board is a perfect fit.

  $set->as_abstractor();

The result is always balanced (the hump, if any, is in the middle).

The single result set contains exactly one subset, which is of type 'abstract'.
To do operations on that with anything other than C or a Permutator,
you'll need to change the type to match the desired subset type of the other set.

  my $foo = new AI::FuzzyLogic 'foo', 0.1, 0.2, 0.5, 0.2, 0.1;

  my $bar = $big_old_set->as_abstractor() & $another_big_old_set();

  $bar->change_type('abstract', 'foo'); # change result from "abstract" to "foo" type

  my $baz = $foo & $bar;

Beware! Once created, you'll need to change the combinational behavior frequently
to get any work done. These C methods will need to be used over and over.

=cut

package AI::FuzzyLogic::Abstractor;
use base 'AI::FuzzyLogic';
sub AI::FuzzyLogic::as_abstractor { bless $_[0], __PACKAGE__; }
sub selector {
  my $me = shift;
  my $them = shift; $them->isa('AI::FuzzyLogic') or die 'instance of AI::FuzzyLogic needed';
  my $coderef = shift; ref $coderef eq 'CODE' or die 'no coderef';
  my @newset;
  foreach my $mysubset ($me->unwrap()) {
    foreach my $theirsubset ($them->unwrap()) {
      next unless $mysubset->type() eq $theirsubset->type();
      push @newset, $coderef->($mysubset, $theirsubset);
    }
  }
  # for each subset, find the average of all segments; these averages, balanced, are our new set of one subset
  return $me->new('abstract', sort map { $_->mean_inner() } @newset)->balance();
}
1;

=head3 Discriminators

Discriminators pare down sets which have subsets.

Discriminators consider all of the permutations, but throw away all of them except
the set from the right-hand-side which yeildeds the largest resulting set
(defined by volume). Hence, whichever operation is performed on a discriminator
only serves to give a criteria for selecting a set from the right-hand-side.
Discriminators are useful for selecting one optimial case from a number of alternatives.
Like the permutator, except we only keep the highest ranked cross matches.
Always returns exactly one set from the right hand side. The left hand side is considered
to be the rule by which to measure the left.

  $set->as_discriminator();

=cut

package AI::FuzzyLogic::Discriminator;
use base 'AI::FuzzyLogic';
sub AI::FuzzyLogic::as_discriminator { bless $_[0], __PACKAGE__; }
sub selector {
  my $me = shift;
  my $them = shift; $them or die; $them->isa('AI::FuzzyLogic') or die 'instance of AI::FuzzyLogic needed';
  my $coderef = shift; ref $coderef eq 'CODE' or die 'no coderef';

  my $highestrankedset;
  my $highestrankedvalue;
  my @ret;

  foreach my $mysubset ($me->unwrap()) {
    $highestrankedvalue = 0;
    $highestrankedset = undef;
    foreach my $theirsubset ($them->unwrap()) {
      my $value = $coderef->($mysubset, $theirsubset)->mean_inner();
      if($value > $highestrankedvalue) {
        $highestrankedvalue = $value;
        $highestrankedset = $theirsubset;
      }
    }
    # push @ret, $highestrankedset->clone() if $highestrankedset; # XXX there is no clone()!
    push @ret, $highestrankedset if $highestrankedset;
  }
  return unless @ret;
  return $me->new(@ret);
}
1;

=head3 Permutators

Permutators consider every possible permutation between subsets in the object on
the left-hand-side and the subsets in the object on the right-hand-side, and return
an object with a subset for each permutation. Performs the desired operation
as a cartesian product.

  $set->as_permutator();

=cut

package AI::FuzzyLogic::Permutator;
use base 'AI::FuzzyLogic';
sub AI::FuzzyLogic::as_permutator { bless $_[0], __PACKAGE__; }
sub selector {
  # given two objects and a code ref, find cartesian products with coderef performed on them.
  my $me = shift;
  my $them = shift; $them->isa('AI::FuzzyLogic') or die 'instance of AI::FuzzyLogic needed';
  my $coderef = shift; ref $coderef eq 'CODE' or die 'no coderef';
  my @ret;
  foreach my $mysubset ($me->unwrap()) {
    foreach my $theirsubset ($them->unwrap()) {
      push @ret, $coderef->($mysubset, $theirsubset);
    }
  }
  return undef unless @ret;
  return $me->new(@ret);
}
1;

=head3 Correlators

Correlators are like Permutators, except instead of considering all permutations,
they only consider permutations between subsets with matching unit types.
Permutators and Correlators are useful for generating alternative cases, possibly in
several steps, which Discriminators or Abstractors may then select from.

Useful for finding optimal cases. For example, combinations of two or more
gears can be considered, and then in an additional step, the combination best
matching some criteria could be selected.

  $set->as_correlator();

=cut

package AI::FuzzyLogic::Correlator;
use base 'AI::FuzzyLogic';
sub AI::FuzzyLogic::as_correlator { bless $_[0], __PACKAGE__; }
sub selector {
  # perform operations between matching type subsets between two objects
  my $me = shift;
  my $them = shift; $them->isa('AI::FuzzyLogic') or die 'instance of AI::FuzzyLogic needed';
  my $coderef = shift; ref $coderef eq 'CODE' or die 'no coderef';
  my @ret;
  foreach my $mysubset ($me->unwrap()) {
    foreach my $theirsubset ($them->unwrap()) {
      next unless $mysubset->type() eq $theirsubset->type();
      push @ret, $coderef->($mysubset, $theirsubset);
    }
  }
  return undef unless @ret;
  return $me->new(@ret);
}
1;

__END__