File Coverage

blib/lib/AI/FuzzyEngine.pm
Criterion Covered Total %
statement 54 76 71.0
branch 2 14 14.2
condition n/a
subroutine 21 23 91.3
pod 5 9 55.5
total 82 122 67.2


line stmt bran cond sub pod time code
1             package AI::FuzzyEngine;
2            
3 3     3   25463 use 5.008009;
  3         10  
  3         126  
4 3     3   849 use version 0.77; our $VERSION = version->declare('v0.2.2');
  3         2419  
  3         22  
5            
6 3     3   254 use strict;
  3         9  
  3         93  
7 3     3   13 use warnings;
  3         10  
  3         86  
8 3     3   18 use Carp;
  3         5  
  3         223  
9 3     3   15 use Scalar::Util;
  3         6  
  3         109  
10 3     3   14 use List::Util;
  3         5  
  3         195  
11 3     3   1496 use List::MoreUtils;
  3         1329  
  3         119  
12            
13 3     3   694 use AI::FuzzyEngine::Variable;
  3         7  
  3         2523  
14            
15             sub new {
16 5     5 0 8882 my ($class) = @_;
17 5         18 my $self = bless {}, $class;
18            
19 5         21 $self->{_variables} = [];
20 5         22 return $self;
21             }
22            
23 3     3 0 7 sub variables { @{ shift->{_variables} } };
  3         17  
24            
25             sub and {
26 25     25 1 695 my ($self, @vals) = @_;
27            
28             # PDL awareness: any element is a piddle?
29 25 50       61 return List::Util::min(@vals) if _non_is_a_piddle(@vals);
30            
31 0         0 _check_for_PDL();
32 0         0 my $vals = $self->_cat_array_of_piddles(@vals);
33 0         0 return $vals->mv(-1, 0)->minimum;
34             }
35            
36             sub or {
37 24     24 1 57 my ($self, @vals) = @_;
38            
39             # PDL awareness: any element is a piddle?
40 24 50       52 return List::Util::max(@vals) if _non_is_a_piddle(@vals);
41            
42 0         0 _check_for_PDL();
43 0         0 my $vals = $self->_cat_array_of_piddles(@vals);
44 0         0 return $vals->mv(-1, 0)->maximum;
45             }
46            
47             sub not {
48 5     5 1 544 my ($self, $val) = @_;
49 5         21 return 1-$val;
50             }
51            
52 2     2 1 554 sub true { return 1 }
53            
54 2     2 1 527 sub false { return 0 }
55            
56             sub new_variable {
57 6     6 0 734 my ($self, @pars) = @_;
58            
59 6         16 my $variable_class = $self->_class_of_variable();
60 6         28 my $var = $variable_class->new($self, @pars);
61 6         9 push @{$self->{_variables}}, $var;
  6         106  
62 6         18 Scalar::Util::weaken $self->{_variables}->[-1];
63 6         17 return $var;
64             }
65            
66             sub reset {
67 2     2 0 9 my ($self) = @_;
68 2         7 $_->reset() for $self->variables();
69 2         6 return $self;
70             }
71            
72 6     6   10 sub _class_of_variable { 'AI::FuzzyEngine::Variable' }
73            
74             sub _non_is_a_piddle {
75 95     95   409 return List::MoreUtils::none {ref $_ eq 'PDL'} @_;
  49     49   226  
76             }
77            
78             my $_PDL_is_imported;
79             sub _check_for_PDL {
80 0 0   0     return if $_PDL_is_imported;
81 0 0         die "PDL not loaded" unless $INC{'PDL.pm'};
82 0 0         die "PDL::Core not loaded" unless $INC{'PDL/Core.pm'};
83 0           $_PDL_is_imported = 1;
84             }
85            
86             sub _cat_array_of_piddles {
87 0     0     my ($class, @vals) = @_;
88            
89             # TODO: Rapid return if @_ == 1 (isa piddle)
90             # TODO: join "-", ndims -> Schnellcheck auf gleiche Dim.
91            
92             # All elements must get piddles
93 0           my @pdls = map { PDL::Core::topdl($_) } @vals;
  0            
94            
95             # Get size of wrapping piddle (using a trick)
96             # applying valid expansion rules for element wise operations
97 0           my $zeros = PDL->pdl(0);
98             # v-- does not work due to threading mechanisms :-((
99             # $zeros += $_ for @pdls;
100             # Avoid threading!
101 0           for my $p (@pdls) {
102 0 0         croak "Empty piddles are not allowed" if $p->isempty();
103 0 0         eval { $zeros = $zeros + $p->zeros(); 1
  0            
  0            
104             } or croak q{Can't expand piddles to same size};
105             }
106            
107             # Now, cat 'em by expanding them on the fly
108 0           my $vals = PDL::cat( map {$_ + $zeros} @pdls );
  0            
109 0           return $vals;
110             };
111            
112             1;
113            
114             =pod
115            
116             =head1 NAME
117            
118             AI::FuzzyEngine - A Fuzzy Engine, PDL aware
119            
120             =head1 SYNOPSIS
121            
122             =head2 Regular Perl - without PDL
123            
124             use AI::FuzzyEngine;
125            
126             # Engine (or factory) provides fuzzy logical arithmetic
127             my $fe = AI::FuzzyEngine->new();
128            
129             # Disjunction:
130             my $a = $fe->or ( 0.2, 0.5, 0.8, 0.7 ); # 0.8
131             # Conjunction:
132             my $b = $fe->and( 0.2, 0.5, 0.8, 0.7 ); # 0.2
133             # Negation:
134             my $c = $fe->not( 0.4 ); # 0.6
135             # Always true:
136             my $t = $fe->true(); # 1.0
137             # Always false:
138             my $f = $fe->false(); # 0.0
139            
140             # These functions are constitutive for the operations
141             # on the fuzzy sets of the fuzzy variables:
142            
143             # VARIABLES (AI::FuzzyEngine::Variable)
144            
145             # input variables need definition of membership functions of their sets
146             my $flow = $fe->new_variable( 0 => 2000,
147             small => [0, 1, 500, 1, 1000, 0 ],
148             med => [ 400, 0, 1000, 1, 1500, 0 ],
149             huge => [ 1000, 0, 1500, 1, 2000, 1],
150             );
151             my $cap = $fe->new_variable( 0 => 1800,
152             avg => [0, 1, 1500, 1, 1700, 0 ],
153             high => [ 1500, 0, 1700, 1, 1800, 1],
154             );
155             # internal variables need sets, but no membership functions
156             my $saturation = $fe->new_variable( # from => to may be ommitted
157             low => [],
158             crit => [],
159             over => [],
160             );
161             # But output variables need membership functions for their sets:
162             my $green = $fe->new_variable( -5 => 5,
163             decrease => [-5, 1, -2, 1, 0, 0 ],
164             ok => [ -2, 0 0, 1, 2, 0 ],
165             increase => [ 0, 0, 2, 1, 5, 1],
166             );
167            
168             # Reset FuzzyEngine (resets all variables)
169             $fe->reset();
170            
171             # Reset a fuzzy variable directly
172             $flow->reset;
173            
174             # Membership functions can be changed via the set's variable.
175             # This might be useful during parameter identification algorithms
176             # Changing a function resets the respective variable.
177             $flow->change_set( med => [500, 0, 1000, 1, 1500, 0] );
178            
179             # Fuzzification of input variables
180             $flow->fuzzify( 600 );
181             $cap->fuzzify( 1000 );
182            
183             # Membership degrees of the respective sets are now available:
184             my $flow_is_small = $flow->small(); # 0.8
185             my $flow_is_med = $flow->med(); # 0.2
186             my $flow_is_huge = $flow->huge(); # 0.0
187            
188             # RULES and their application
189            
190             # a) If necessary, calculate some internal variables first.
191             # They will not be defuzzified (in fact, $saturation can't)
192             # Implicit application of 'and'
193             # Multiple calls to a membership function
194             # are similar to 'or' operations:
195             $saturation->low( $flow->small(), $cap->avg() );
196             $saturation->low( $flow->small(), $cap->high() );
197             $saturation->low( $flow->med(), $cap->high() );
198            
199             # Explicite 'or', 'and' or 'not' possible:
200             $saturation->crit( $fe->or( $fe->and( $flow->med(), $cap->avg() ),
201             $fe->and( $flow->huge(), $cap->high() ),
202             ),
203             );
204             $saturation->over( $fe->not( $flow->small() ),
205             $fe->not( $flow->med() ),
206             $flow->huge(),
207             $cap->high(),
208             );
209             $saturation->over( $flow->huge(), $fe->not( $cap->high() ) );
210            
211             # b) deduce output variable(s) (here: from internal variable $saturation)
212             $green->decrease( $saturation->low() );
213             $green->ok( $saturation->crit() );
214             $green->increase( $saturation->over() );
215            
216             # All sets provide their respective membership degrees:
217             my $saturation_is_over = $saturation->over(); # This is no defuzzification!
218             my $green_is_ok = $green->ok();
219            
220             # Defuzzification ( is a matter of the fuzzy variable )
221             my $delta_green = $green->defuzzify(); # -5 ... 5
222            
223             =head2 Using PDL and its threading capability
224            
225             use PDL;
226             use AI::FuzzyEngine;
227            
228             # (Probably a stupide example)
229             my $fe = AI::FuzzyEngine->new();
230            
231             # Declare variables as usual
232             my $severity = $fe->new_variable( 0 => 10,
233             low => [0, 1, 3, 1, 5, 0 ],
234             high => [ 3, 0, 5, 1, 10, 1],
235             );
236            
237             my $threshold = $fe->new_variable( 0 => 1,
238             low => [0, 1, 0.2, 1, 0.8, 0, ],
239             high => [ 0.2, 0, 0.8, 1, 1, 1],
240             );
241            
242             my $problem = $fe->new_variable( -0.5 => 2,
243             no => [-0.5, 0, 0, 1, 0.5, 0, 1, 0],
244             yes => [ 0, 0, 0.5, 1, 1, 1, 1.5, 1, 2, 0],
245             );
246            
247             # Input data is a pdl of arbitrary dimension
248             my $data = pdl( [0, 4, 6, 10] );
249             $severity->fuzzify( $data );
250            
251             # Membership degrees are piddles now:
252             print 'Severity is high: ', $severity->high, "\n";
253             # [0 0.5 1 1]
254            
255             # Other variables might be piddles of other dimensions,
256             # but all variables must be expandible to a common 'wrapping' piddle
257             # ( in this case a 4x2 matrix with 4 colums and 2 rows)
258             my $level = pdl( [0.6],
259             [0.2],
260             );
261             $threshold->fuzzify( $level );
262            
263             print 'Threshold is low: ', $threshold->low(), "\n";
264             # [
265             # [0.33333333]
266             # [ 1]
267             # ]
268            
269             # Apply some rules
270             $problem->yes( $severity->high, $threshold->low );
271             $problem->no( $fe->not( $problem->yes ) );
272            
273             # Fuzzy results are represented by the membership degrees of sets
274             print 'Problem yes: ', $problem->yes, "\n";
275             # [
276             # [ 0 0.33333333 0.33333333 0.33333333]
277             # [ 0 0.5 1 1]
278             # ]
279            
280             # Defuzzify the output variables
281             # Caveat: This includes some non-threadable operations up to now
282             my $problem_ratings = $problem->defuzzify();
283             print 'Problems rated: ', $problem_ratings;
284             # [
285             # [ 0 0.60952381 0.60952381 0.60952381]
286             # [ 0 0.75 1 1]
287             # ]
288            
289             =head1 EXPORT
290            
291             Nothing is exported or exportable.
292            
293             =head1 DESCRIPTION
294            
295             This module is yet another implementation of a fuzzy inference system.
296             The aim was to be able to code rules (no string parsing),
297             but avoid operator overloading,
298             and make it possible to split calculation into multiple steps.
299             All intermediate results (memberships of sets of variables)
300             should be available.
301            
302             Beginning with v0.2.0 it is PDL aware,
303             meaning that it can handle piddles (PDL objects)
304             when running the fuzzy operations.
305             More information on PDL can be found at L.
306            
307             Credits to Ala Qumsieh and his L,
308             that showed me that fuzzy is no magic.
309             I learned a lot by analyzing his code,
310             and he provides good information and links to learn more about Fuzzy Logics.
311            
312             =head2 Fuzzy stuff
313            
314             The L object defines and provides
315             the elementary operations for fuzzy sets.
316             All membership degrees of sets are values from 0 to 1.
317             Up to now there is no choice with regard to how to operate on sets:
318            
319             =over 2
320            
321             =item C<< $fe->or( ... ) >> (Disjunction)
322            
323             is I of membership degrees
324            
325             =item C<< $fe->and( ... ) >> (Conjunction)
326            
327             is I of membership degrees
328            
329             =item C<< $fe->not( $var->$set ) >> (Negation)
330            
331             is I<1-degree> of membership degree
332            
333             =item Aggregation of rules (Disjunction)
334            
335             is I
336            
337             =item True C<< $fe->true() >> and false C<< $fe->false() >>
338            
339             are provided for convenience.
340            
341             =back
342            
343             Defuzzification is based on
344            
345             =over 2
346            
347             =item Implication
348            
349             I membership function of a set according to membership degree,
350             before the implicated memberships of all sets of a variable are taken for defuzzification:
351            
352             =item Defuzzification
353            
354             I of aggregated (and clipped) membership functions
355            
356             =back
357            
358             =head2 Public functions
359            
360             Creation of an C object by
361            
362             my $fe = AI::FuzzyEngine->new();
363            
364             This function has no parameters. It provides the fuzzy methods
365             C, C and C, as listed above.
366             If needed, I will introduce alternative fuzzy operations,
367             they will be configured as arguments to C.
368            
369             Once built, the engine can create fuzzy variables by C:
370            
371             my $var = $fe->new_variable( $from => $to,
372             $name_of_set1 => [$x11, $y11, $x12, $y12, ... ],
373             $name_of_set2 => [$x21, $y21, $x22, $y22, ... ],
374             ...
375             );
376            
377             Result is an L.
378             The name_of_set strings are taken to assign corresponding methods
379             for the respective fuzzy variables.
380             They must be valid function identifiers.
381             Same name_of_set can used for different variables without conflict.
382             Take care:
383             There is no check for conflicts with predefined class methods.
384            
385             Fuzzy variables provide a method to fuzzify input values:
386            
387             $var->fuzzify( $val );
388            
389             according to the defined sets and their membership functions.
390            
391             The memberships of the sets of C<$var> are accessible
392             by the respective functions:
393            
394             my $membership_degree = $var->$name_of_set();
395            
396             Membership degrees can be assigned directly (within rules for example):
397            
398             $var->$name_of_set( $membership_degree );
399            
400             If multiple membership_degrees are given, they are "anded":
401            
402             $var->$name_of_set( $degree1, $degree2, ... ); # "and"
403            
404             By this, simple rules can be coded directly:
405            
406             my $var_3->zzz( $var_1->xxx, $var_2->yyy, ... ); # "and"
407            
408             this implements the fuzzy implication
409            
410             if $var_1->xxx and $var_2->yyy and ... then $var_3->zzz
411            
412             The membership degrees of a variable's sets can be reset to undef:
413            
414             $var->reset(); # resets a variable
415             $fe->reset(); # resets all variables
416            
417             The fuzzy engine C<$fe> has all variables registered
418             that have been created by its C method.
419            
420             A variable can be defuzzified:
421            
422             my $out_value = $var->defuzzify();
423            
424             Membership functions can be replaced via a set's variable:
425            
426             $var->change_set( $name_of_set => [$x11n, $y11n, $x12n, $y12n, ... ] );
427            
428             The variable will be reset when replacing a membership function
429             of any of its sets.
430             Interdependencies with other variables are not checked
431             (it might happen that the results of any rules are no longer valid,
432             so it needs some recalculations).
433            
434             Sometimes internal variables are used that need neither fuzzification
435             nor defuzzification.
436             They can be created by a simplified call to C:
437            
438             my $var_int = $fe->new_variable( $name_of_set1 => [],
439             $name_of_set2 => [],
440             ...
441             );
442            
443             Hence, they can not use the methods C or C.
444            
445             Fuzzy operations are simple operations on floating values between 0 and 1:
446            
447             my $conjunction = $fe->and( $var1->xxx, $var2->yyy, ... );
448             my $disjunction = $fe->or( $var1->xxx, $var2->yyy, ... );
449             my $negated = $fe->not( $var1->zzz );
450            
451             There is no magic.
452            
453             A sequence of rules for the same set can be implemented as follows:
454            
455             $var_3->zzz( $var_1->xxx, $var_2->yyy, ... );
456             $var_3->zzz( $var_4->aaa, $var_5->bbb, ... );
457            
458             The subsequent application of C<< $var_3->zzz(...) >>
459             corresponds to "or" operations (aggregation of rules).
460            
461             Only a reset can reset C<$var_3>.
462            
463             =head2 PDL awareness
464            
465             Membership degrees of sets might be either scalars or piddles now.
466            
467             $var_a->memb_fun_a( 5 ); # degree of memb_fun_a is a scalar
468             $var_a->memb_fun_b( pdl(7, 8) ); # degree of memb_fun_b is a piddle
469            
470             Empty piddles are not allowed, behaviour with bad values is not tested.
471            
472             Fuzzification (hence calculating degrees) accepts piddles:
473            
474             $var_b->fuzzify( pdl([1, 2], [3, 4]) );
475            
476             Defuzzification returns a piddle if any of the membership
477             degrees of the function's sets is a piddle:
478            
479             my $val = $var_a->defuzzify(); # $var_a returns a 1dim piddle with two elements
480            
481             So do the fuzzy operations as provided by the fuzzy engine C<$fe> itself.
482            
483             Any operation on more then one piddle expands those to common
484             dimensions, if possible, or throws a PDL error otherwise.
485            
486             The way expansion is done is best explained by code
487             (see C<< AI::FuzzyEngine->_cat_array_of_piddles(@pdls) >>).
488             Assuming all piddles are in C<@pdls>,
489             calculation goes as follows:
490            
491             # Get the common dimensions
492             my $zeros = PDL->pdl(0);
493             # Note: $zeros += $_->zeros() for @pdls does not work here
494             $zeros = $zeros + $_->zeros() for @pdls;
495            
496             # Expand all piddles
497             @pdls = map {$_ + $zeros} @pdls;
498            
499             Defuzzification uses some heavy non-threading code,
500             so there might be a performance penalty for big piddles.
501            
502             =head2 Todos
503            
504             =over 2
505            
506             =item Add optional alternative implementations of fuzzy operations
507            
508             =item More checks on input arguments and allowed method calls
509            
510             =item PDL awareness: Use threading in C<< $variable->defuzzify >>
511            
512             =item Divide tests into API tests and test of internal functions
513            
514             =back
515            
516             =head1 CAVEATS / BUGS
517            
518             This is my first module.
519             I'm happy about feedback that helps me to learn
520             and improve my contributions to the Perl ecosystem.
521            
522             Please report any bugs or feature requests to
523             C, or through
524             the web interface at
525             L.
526             I will be notified, and then you'll
527             automatically be notified of progress on your bug as I make changes.
528            
529             =head1 SUPPORT
530            
531             You can find documentation for this module with the perldoc command.
532            
533             perldoc AI::FuzzyEngine
534            
535             =head1 AUTHOR
536            
537             Juergen Mueck, jmueck@cpan.org
538            
539             =head1 COPYRIGHT
540            
541             Copyright (c) Juergen Mueck 2013. All rights reserved.
542            
543             This library is free software; you can redistribute it and/or
544             modify it under the same terms as Perl itself.
545            
546             =cut