Hi,
Here is a program that permits to create fuzzy systems.
Save this program as "fuzzy.fs" and include it in the programs where the fuzzy systems will be created.
Notice that you can create several fuzzy systems in the same program.

\ the code begins here:

\ Mamdani type fuzzy system with normalized output (in [-1, 1])

variable tnorm
variable tconorm
variable (in_fuzzify)
variable (out_fuzzify)
variable (rules)

: tnorm: ' tnorm ! ;
: tconorm: ' tconorm ! ;
: in_fuzzify: ' (in_fuzzify) ! ;
: out_fuzzify: ' (out_fuzzify) ! ;
: rules: ' (rules) ! ;


fvariable fs_output
: output: fs_output create , does> @ ;
: inputs: 0 ?do fvariable loop ;


\ we use membership functions: gaussian, triangular, trapezoidal, ... Just define them
\ gaussian membership function mf = mf_gauss(x;m,s) = exp(-0.5*((x-m)/s)^2)
: mf_gauss ( f: x m s -- f: md ) frot frot f- fswap f/ fdup f* 0.5e f* fnegate fexp ;


\ using prod as tnorm and probabilistic sum as tconorm,
\ we can use fmin and fmax for tnorm and tconorm respectively
: prod f* ;
: prob_sum fover fover f* f- f+ ; \ (u,v)---> u+v-u*v

\ use fmin or fmax already defined directly
\ : fmin fmin ;
\ : fmax fmax ;


\ to write rules
: fuzzy_propositions: 0 ?do 0e fvalue loop ;
: .and. tnorm @ execute ;
: .or. tconorm @ execute ;
: .if. 1e ;
: .then. tnorm @ execute ;
: )r tnorm @ execute ;
: r( ; immediate
: rt( 0e ;
: )rt tconorm @ execute ;
: .is. f@ ;

: infere (out_fuzzify) @ execute (rules) @ execute ;

10 value N/2
N/2 negate value N_begin
N/2 1+ value N_end
N/2 s>f 1/f fvalue out_step

: infere_defuzz ( f: -- z* )
0e 0e ( f: s_mfz s_mf )
N_end N_begin
do
fswap ( f: s_mf s_mfz )
i s>f out_step f* ( f: s_mf s_mfz z )
fs_output f! ( f: s_mf s_mfz )
infere ( f: s_mf s_mfz mf)
ftuck fs_output f@ f* f+ ( f: s_mf mf s_mfz)
frot frot f+ ( f: s_mfz s_mf)
loop
f/ ;

: (fuzzy_system) (in_fuzzify) @ execute infere_defuzz fs_output f! ;
: fuzzy_system: ['] (fuzzy_system)
create , tnorm @ , tconorm @ , (in_fuzzify) @ , (out_fuzzify) @ , (rules) @ ,
does> dup
cell+ dup @ tnorm !
cell+ dup @ tconorm !
cell+ dup @ (in_fuzzify) !
cell+ dup @ (out_fuzzify) !
cell+ @ (rules) !
@ execute ;

\ the code finishes here.

Enjoy,
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le vendredi 15 septembre 2023 à 11:39:45 UTC, Ahmed MELAHI a écrit :

Hi,
Here is a program that permits to create fuzzy systems.
Save this program as "fuzzy.fs" and include it in the programs where the fuzzy systems will be created.
Notice that you can create several fuzzy systems in the same program.

\ the code begins here:

\ Mamdani type fuzzy system with normalized output (in [-1, 1])

variable tnorm
variable tconorm
variable (in_fuzzify)
variable (out_fuzzify)
variable (rules)

: tnorm: ' tnorm ! ;
: tconorm: ' tconorm ! ;
: in_fuzzify: ' (in_fuzzify) ! ;
: out_fuzzify: ' (out_fuzzify) ! ;
: rules: ' (rules) ! ;

fvariable fs_output
: output: fs_output create , does> @ ;
: inputs: 0 ?do fvariable loop ;

\ we use membership functions: gaussian, triangular, trapezoidal, ... Just define them
\ gaussian membership function mf = mf_gauss(x;m,s) = exp(-0.5*((x-m)/s)^2) : mf_gauss ( f: x m s -- f: md ) frot frot f- fswap f/ fdup f* 0.5e f* fnegate fexp ;

\ using prod as tnorm and probabilistic sum as tconorm,
\ we can use fmin and fmax for tnorm and tconorm respectively
: prod f* ;
: prob_sum fover fover f* f- f+ ; \ (u,v)---> u+v-u*v

\ use fmin or fmax already defined directly
\ : fmin fmin ;
\ : fmax fmax ;

\ to write rules
: fuzzy_propositions: 0 ?do 0e fvalue loop ;
: .and. tnorm @ execute ;
: .or. tconorm @ execute ;
: .if. 1e ;
: .then. tnorm @ execute ;
: )r tnorm @ execute ;
: r( ; immediate
: rt( 0e ;
: )rt tconorm @ execute ;
: .is. f@ ;

: infere (out_fuzzify) @ execute (rules) @ execute ;

10 value N/2
N/2 negate value N_begin
N/2 1+ value N_end
N/2 s>f 1/f fvalue out_step

: infere_defuzz ( f: -- z* )
0e 0e ( f: s_mfz s_mf )
N_end N_begin
do
fswap ( f: s_mf s_mfz )
i s>f out_step f* ( f: s_mf s_mfz z )
fs_output f! ( f: s_mf s_mfz )
infere ( f: s_mf s_mfz mf)
ftuck fs_output f@ f* f+ ( f: s_mf mf s_mfz)
frot frot f+ ( f: s_mfz s_mf)
loop
f/ ;

: (fuzzy_system) (in_fuzzify) @ execute infere_defuzz fs_output f! ;
: fuzzy_system: ['] (fuzzy_system)
create , tnorm @ , tconorm @ , (in_fuzzify) @ , (out_fuzzify) @ , (rules) @ ,
does> dup
cell+ dup @ tnorm !
cell+ dup @ tconorm !
cell+ dup @ (in_fuzzify) !
cell+ dup @ (out_fuzzify) !
cell+ @ (rules) !
@ execute ;

\ the code finishes here.

Enjoy,
Bye

Hi again,
Here an example how to use this program:

\ here begins the code


s" fuzzy.fs" included

\ example 1
\ fuzzy system FS1 with: 2 inputs x and y
\ 1 output z

2 inputs: x y
output: z

\ print x, y and z
: .xyz cr ." X = " x f@ f. cr ." Y = " y f@ f. cr ." Z = " z f@ f. ;

\ we use gaussian membership functions for the three fuzzy variables,
\ for input x
: nb1 -1e 0.2e mf_gauss ;
: ze1 0e 0.2e mf_gauss ;
: pb1 1e 0.2e mf_gauss ;

\ for input y
: nb2 -1e 0.2e mf_gauss ;
: ze2 0e 0.2e mf_gauss ;
: pb2 1e 0.2e mf_gauss ;

\ for output z
: nb3 -1e 0.2e mf_gauss ;
: ze3 0e 0.2e mf_gauss ;
: pb3 1e 0.2e mf_gauss ;


\ fuzzy propositions for rules
3 fuzzy_propositions: x_is_nb1 x_is_ze1 x_is_pb1 \ for input x
3 fuzzy_propositions: y_is_nb2 y_is_ze2 y_is_pb2 \ for input y
3 fuzzy_propositions: z_is_nb3 z_is_ze3 z_is_pb3 \ for output z

: in_fuzzify
x .is. nb1 to x_is_nb1
x .is. ze1 to x_is_ze1
x .is. pb1 to x_is_pb1

y .is. nb2 to y_is_nb2
y .is. ze2 to y_is_ze2
y .is. pb2 to y_is_pb2
;

: out_fuzzify
z .is. nb3 to z_is_nb3
z .is. ze3 to z_is_ze3
z .is. pb3 to z_is_pb3
;

\ the fuzzy rules are given as below
: rules_1
rt(
r( .if. x_is_nb1 .and. y_is_nb2 .then. z_is_nb3 )r .or.
r( .if. x_is_nb1 .and. y_is_ze2 .then. z_is_nb3 )r .or.
r( .if. x_is_nb1 .and. y_is_pb2 .then. z_is_ze3 )r .or.
r( .if. x_is_ze1 .and. y_is_nb2 .then. z_is_nb3 )r .or.
r( .if. x_is_ze1 .and. y_is_ze2 .then. z_is_ze3 )r .or.
r( .if. x_is_ze1 .and. y_is_pb2 .then. z_is_pb3 )r .or.
r( .if. x_is_pb1 .and. y_is_nb2 .then. z_is_ze3 )r .or.
r( .if. x_is_pb1 .and. y_is_ze2 .then. z_is_pb3 )r .or.
r( .if. x_is_pb1 .and. y_is_pb2 .then. z_is_pb3 )r
)rt
;

\ create the fuzzy system FS1
tnorm: prod
tconorm: prob_sum
in_fuzzify: in_fuzzify
out_fuzzify: out_fuzzify
rules: rules_1
fuzzy_system: FS1



\ ------------------------------------------------------------
\ -------------------------------------------------------------
\ example 2
\ fuzzy system FS2 with: 1 input x2
\ 1 output z2

1 inputs: x2
output: z2

\ print x2 and z2
: .xz_2 cr ." X2 = " x2 f@ f. cr ." Z2 = " z2 f@ f. ;

\ we use gaussian membership functions for the three fuzzy variables,
\ for input x2
: nb1_2 -1e 0.25e mf_gauss ;
: pb1_2 1e 0.25e mf_gauss ;

\ for output z2
: nb3_2 -1e 0.25e mf_gauss ;
: pb3_2 1e 0.25e mf_gauss ;


\ fuzzy propositions for rules
2 fuzzy_propositions: x2_is_nb1_2 x2_is_pb1_2 \ for input x2
2 fuzzy_propositions: z2_is_nb3_2 z2_is_pb3_2 \ for output z2

: in_fuzzify_2
x2 .is. nb1_2 to x2_is_nb1_2
x2 .is. pb1_2 to x2_is_pb1_2
;

: out_fuzzify_2
z2 .is. nb3_2 to z2_is_nb3_2
z2 .is. pb3_2 to z2_is_pb3_2
;

\ the fuzzy rules are given as below
: rules_2
rt(
r( .if. x2_is_nb1_2 .then. z2_is_pb3_2 )r .or.
r( .if. x2_is_pb1_2 .then. z2_is_nb3_2 )r
)rt
;

\ create the fuzzy system FS2
tnorm: fmin
tconorm: fmax
in_fuzzify: in_fuzzify_2
out_fuzzify: out_fuzzify_2
rules: rules_2
fuzzy_system: FS2

\ examples of results
1 [if]
0e x f! 0e y f! FS1 .xyz cr \ print x y and the result which is in z
-1e x f! -1e y f! FS1 .xyz cr \ print x y and the result which is in z
1e x f! 1e y f! FS1 .xyz cr \ print x y and the result which is in z

-1e x2 f! FS2 .xz_2 cr \ print x2 and the result which is in z2
0e x2 f! FS2 .xz_2 cr \ print x2 and the result which is in z2
1e x2 f! FS2 .xz_2 cr \ print x2 and the result which is in z2
[THEN]


\ timing
variable FS
: FS_EXEC FS @ execute ;
: timing_10000: cr ' FS ! timer-reset 10000 0 do FS_EXEC loop .elapsed ." for 10000 times." cr ;
timing_10000: FS1
timing_10000: FS2


\ here the code finishes
The program was tested with gforth, vfxforth and iforth version 4.0
the timing was interesting:
gforth:
FS1: 20 micro seconds
FS2: 06 micro seconds
vfxforth:
FS1: 11 micro seconds
FS2: 9.5 micro seconds
iForth:
FS1: 14 micro seconds
FS2: 05 micro seconds

Notice that FS1 and FS2 works in the same program.
Enjoy
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Friday, September 15, 2023 at 1:46:54 PM UTC+2, Ahmed MELAHI wrote:

Le vendredi 15 septembre 2023 à 11:39:45 UTC, Ahmed MELAHI a écrit :

[..]

The program was tested with gforth, vfxforth and iforth version 4.0
the timing was interesting:
gforth:
FS1: 20 micro seconds
FS2: 06 micro seconds
vfxforth:
FS1: 11 micro seconds
FS2: 9.5 micro seconds
iForth:
FS1: 14 micro seconds
FS2: 05 micro seconds

Notice that FS1 and FS2 works in the same program.

I like the naming much better now (personal preference).

And indeed, the timing is fascinating:

[1] iForth x64 server 1.32 (console), Aug 24 2023, 23:22:14.
[2] Stuffed iForth at $0109DB00 [entry: $01100000]
[3] Having a Windows terminal.
[4] Console is active.
[5] Sound devices are internal.

iForth version 6.9.109, generated 18:39:31, September 27, 2021.
x86_64 binary, native floating-point, extended precision.
Copyright 1996 - 2021 Marcel Hendrix.
[6] Use --- iForth.prf
Creating --- Locate support Version 2.01 ---
Creating --- Several utilities Version 3.53 ---
AMD Ryzen 7 5800X 8-Core Processor
TICKS-GET uses os time & PROCESSOR-CLOCK 4192MHz
Do: < n TO PROCESSOR-CLOCK RECALIBRATE >

in fuzzy2
9.2 us for 1 execution.
3.2 us for 1 execution.

The best runs from 30 or so:
9.1 us for 1 execution.
1.5 us for 1 execution.

The fact that rules_1 is consisting of pure code (everything
inlined) might be too cache-unfriendly.

Your rules look cute, but I think I can read them better
as pure Forth, and then it would be faster still.

\ the fuzzy rules are given as below
: rules_1
0e
1e x_is_nb1 prod y_is_nb2 prod z_is_nb3 prod prob_sum
1e x_is_nb1 prod y_is_ze2 prod z_is_nb3 prod prob_sum
1e x_is_nb1 prod y_is_pb2 prod z_is_ze3 prod prob_sum
1e x_is_ze1 prod y_is_nb2 prod z_is_nb3 prod prob_sum
1e x_is_ze1 prod y_is_ze2 prod z_is_ze3 prod prob_sum
1e x_is_ze1 prod y_is_pb2 prod z_is_pb3 prod prob_sum
1e x_is_pb1 prod y_is_nb2 prod z_is_ze3 prod prob_sum
1e x_is_pb1 prod y_is_ze2 prod z_is_pb3 prod prob_sum
1e x_is_pb1 prod y_is_pb2 prod z_is_pb3 prod
prob_sum
;

FORTH> in fuzzy3
X = 0.000000 Y = 0.000000 Z = 0.000000
X = -1.000000 Y = -1.000000 Z = -0.869768
X = 1.000000 Y = 1.000000 Z = 0.869768
X2 = -1.000000 Z2 = 0.830292
X2 = 0.000000 Z2 = 0.000000
X2 = 1.000000 Z2 = -0.830292
1.9 us for 1 execution.
2.6 us for 1 execution.
ok


-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

I was having fun learning FL, still do, and thought to share what I understood till now. so here is my take as a newbie to FL. I hope i did not make too many mistakes (especially any conceptual ones :) ). The formatting my be messed up.

VOCABULARY FuzzyLogic21 ALSO FuzzyLogic21 DEFINITIONS
\ Assume trapizoidal inputs
\ Assume range is bounded by p1 and p4
\ Assume singleton outputs
\ no verification of rules being complete (covering all cases) is done in this implementation
: lingvar VARIABLE ; \ lingustic variable (input or output is a variable here) : member ( p1 p2 p3 p3 --) CREATE >R SWAP ROT , , , R> , ; \ define input m.ship. function, simple without linking lingvar
: p1 @ ; : p2 CELL+ @ ; : p3 2 CELLS + @ ; : p4 3 CELLS + @ ;
: pts ( mem -- p1 p2 p3 p4 ) >R R@ p1 R@ p2 R@ p3 R> p4 ;
: singleton ( val -- ) CONSTANT ; \ 'member' word could be used with p1, but seemed a waste!
: seg1 ( mem -- p1 p2 ) >R R@ p1 1+ R> p2 1- ; \ ascending line
: seg2 ( mem -- p2 p3 ) >R R@ p2 R> p3 ; \ horizontal line
: seg3 ( mem -- p3 p4 ) >R R@ p3 1+ R> p4 1- ; \ desc. line
1000 VALUE res \ resolution of the 1==1000 value membership
: interpo ( xm y1 y2 -- ym ) >R TUCK - res * SWAP R> - / ABS ; \ interpolate. used for both asc. and desc. lines.
: ]clip[ ( val p1 p2 -- clipped ) ROT DUP >R -ROT 1+ WITHIN ABS R> * ; \ val or zero if out of range
: fuzz ( crisp mem -- fz1 fz2 fz3 ) \ trapizoidal interpolation. is it possible to improve this?
2DUP seg1 ]clip[ IF 2DUP seg1 interpo ELSE 0 THEN -ROT
2DUP seg2 ]clip[ IF res ELSE 0 THEN -ROT
2DUP seg3 ]clip[ IF seg3 SWAP interpo ELSE 2DROP 0 THEN ;

DEFER aggregate
: maximize ( val var -- ) TUCK @ MAX SWAP ! ;
: minimize ( val var -- ) TUCK @ MIN SWAP ! ;
: sum ( val var -- ) +! ;
' maximize IS aggregate
: defuz ( fuz-val lingvar singleton -- ) ROT res */ SWAP aggregate ;

\ Rules compilation
SYNONYM ` POSTPONE
DEFER <IS> IMMEDIATE
DEFER <AND> IMMEDIATE
: nop ;
: compile-at ` @ ;
: compile-fuzz-min ` fuzz ` + ` + ` min ; ' compile-fuzz-min IS <AND>
: compile-<and>-defuz ` defuz ` DUP ;
: antecedent-scope ['] compile-at IS <IS> ['] compile-fuzz-min IS <AND> ;
: consequence-scope ['] nop IS <IS> ['] compile-<and>-defuz IS <AND> ;
: <IF> ` res ` 1+ antecedent-scope ; IMMEDIATE \ max fuz is res, thus 'res 1+' will do with MIN
: <THEN> ` <AND> ` DUP ` IF ` DUP consequence-scope ; IMMEDIATE
: <END> ` defuz ` THEN ` DROP ; IMMEDIATE
: .fired ." Rule " . ." fired! " ;

\
\ Example - car brakes
\
lingvar speed \ in KM\H
0 10 40 50 member low
40 60 80 100 member medium
80 100 320 325 member high

lingvar distance \ in meters
-1 0 20 50 member close
30 60 80 100 member near
80 110 1000 1005 member far

lingvar brake \ measured in N or poundal (this example is illustrative rather than giving experience/measured forces)
0 singleton light
10 singleton moderate
30 singleton hard

: brake-rules
0 brake !
<IF> distance <IS> close <AND> speed <IS> high <THEN> 1 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> medium <THEN> 2 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> low <THEN> 3 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> high <THEN> 4 .fired brake <IS> hard <END>
<IF> distance <IS> near <AND> speed <IS> medium <THEN> 5 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> low <THEN> 6 .fired brake <IS> light <END>
<IF> distance <IS> far <THEN> 7 .fired brake <IS> light <END>
;


: control-brake ( -- b ) brake-rules brake @ ;

CR CR .( Car Brakes example) CR
2 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
50 distance !
CR 45 speed ! control-brake .
CR 90 speed ! control-brake .
CR
50 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
200 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .

\
\ Tipping Examples
\
lingvar service \ level
-2 -1 0 5 member poor
0 5 5 10 member acceptable
5 10 11 12 member amazing

lingvar quality \ of food
-2 -1 0 5 member bad
0 5 5 10 member decent
5 10 11 12 member great

lingvar tip \ percentage
0 singleton low
13 singleton medium
25 singleton high

variable count
: tipping-rules
0 tip ! 0 count !
<IF> service <IS> amazing <THEN> 1 .fired count ++ tip <IS> high <END>
<IF> quality <IS> great <THEN> 2 .fired count ++ tip <IS> high <END>
<IF> service <IS> acceptable <THEN> 3 .fired count ++ tip <IS> medium <END>
<IF> service <IS> poor <AND> quality <IS> poor <THEN> 4 .fired count ++ tip <IS> low <END>
;
' sum is aggregate
: calc-tip tipping-rules tip @ count @ / ;

CR CR .( Tipping example)
CR 6 quality ! 9 service ! calc-tip .
CR 6 quality ! 8 service ! calc-tip .
CR 9 quality ! 4 service ! calc-tip .
CR 3 quality ! 3 service ! calc-tip .


\
\ Example - fan control
\
lingvar temperature
-21 -20 20 40 member cool
20 40 40 50 member warm
40 60 120 121 member hot

lingvar fan-speed
30 singleton slow
60 singleton medium
90 singleton fast


: fan-rules
0 fan-speed !
<IF> temperature <IS> cool <THEN> 1 .fired fan-speed <IS> slow <END>
<IF> temperature <IS> warm <THEN> 2 .fired fan-speed <IS> medium <END>
<IF> temperature <IS> hot <THEN> 3 .fired fan-speed <IS> fast <END>
;

: control-fan fan-rules fan-speed @ ;
: clip-input cool p1 hot p4 WITHIN NOT ABORT" Input out of range!" ;
: control2 clip-input temperature ! control-fan ;

CR CR .( Fan Speed control)
: test 80 0 DO CR I 3 .r space I temperature ! control-fan space 3 .r LOOP ; test

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :

I was having fun learning FL, still do, and thought to share what I understood till now. so here is my take as a newbie to FL. I hope i did not make too many mistakes (especially any conceptual ones :) ). The formatting my be messed up.

VOCABULARY FuzzyLogic21 ALSO FuzzyLogic21 DEFINITIONS
\ Assume trapizoidal inputs
\ Assume range is bounded by p1 and p4
\ Assume singleton outputs
\ no verification of rules being complete (covering all cases) is done in this implementation
: lingvar VARIABLE ; \ lingustic variable (input or output is a variable here)
: member ( p1 p2 p3 p3 --) CREATE >R SWAP ROT , , , R> , ; \ define input m.ship. function, simple without linking lingvar
: p1 @ ; : p2 CELL+ @ ; : p3 2 CELLS + @ ; : p4 3 CELLS + @ ;
: pts ( mem -- p1 p2 p3 p4 ) >R R@ p1 R@ p2 R@ p3 R> p4 ;
: singleton ( val -- ) CONSTANT ; \ 'member' word could be used with p1, but seemed a waste!
: seg1 ( mem -- p1 p2 ) >R R@ p1 1+ R> p2 1- ; \ ascending line
: seg2 ( mem -- p2 p3 ) >R R@ p2 R> p3 ; \ horizontal line
: seg3 ( mem -- p3 p4 ) >R R@ p3 1+ R> p4 1- ; \ desc. line
1000 VALUE res \ resolution of the 1==1000 value membership
: interpo ( xm y1 y2 -- ym ) >R TUCK - res * SWAP R> - / ABS ; \ interpolate. used for both asc. and desc. lines.
: ]clip[ ( val p1 p2 -- clipped ) ROT DUP >R -ROT 1+ WITHIN ABS R> * ; \ val or zero if out of range
: fuzz ( crisp mem -- fz1 fz2 fz3 ) \ trapizoidal interpolation. is it possible to improve this?
2DUP seg1 ]clip[ IF 2DUP seg1 interpo ELSE 0 THEN -ROT
2DUP seg2 ]clip[ IF res ELSE 0 THEN -ROT
2DUP seg3 ]clip[ IF seg3 SWAP interpo ELSE 2DROP 0 THEN ;

DEFER aggregate
: maximize ( val var -- ) TUCK @ MAX SWAP ! ;
: minimize ( val var -- ) TUCK @ MIN SWAP ! ;
: sum ( val var -- ) +! ;
' maximize IS aggregate
: defuz ( fuz-val lingvar singleton -- ) ROT res */ SWAP aggregate ;

\ Rules compilation
SYNONYM ` POSTPONE
DEFER <IS> IMMEDIATE
DEFER <AND> IMMEDIATE
: nop ;
: compile-at ` @ ;
: compile-fuzz-min ` fuzz ` + ` + ` min ; ' compile-fuzz-min IS <AND>
: compile-<and>-defuz ` defuz ` DUP ;
: antecedent-scope ['] compile-at IS <IS> ['] compile-fuzz-min IS <AND> ;
: consequence-scope ['] nop IS <IS> ['] compile-<and>-defuz IS <AND> ;
: <IF> ` res ` 1+ antecedent-scope ; IMMEDIATE \ max fuz is res, thus 'res 1+' will do with MIN
: <THEN> ` <AND> ` DUP ` IF ` DUP consequence-scope ; IMMEDIATE
: <END> ` defuz ` THEN ` DROP ; IMMEDIATE
: .fired ." Rule " . ." fired! " ;

\
\ Example - car brakes
\
lingvar speed \ in KM\H
0 10 40 50 member low
40 60 80 100 member medium
80 100 320 325 member high

lingvar distance \ in meters
-1 0 20 50 member close
30 60 80 100 member near
80 110 1000 1005 member far

lingvar brake \ measured in N or poundal (this example is illustrative rather than giving experience/measured forces)
0 singleton light
10 singleton moderate
30 singleton hard

: brake-rules
0 brake !
<IF> distance <IS> close <AND> speed <IS> high <THEN> 1 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> medium <THEN> 2 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> low <THEN> 3 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> high <THEN> 4 .fired brake <IS> hard <END>
<IF> distance <IS> near <AND> speed <IS> medium <THEN> 5 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> low <THEN> 6 .fired brake <IS> light <END>
<IF> distance <IS> far <THEN> 7 .fired brake <IS> light <END>
;

: control-brake ( -- b ) brake-rules brake @ ;

CR CR .( Car Brakes example) CR
2 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
50 distance !
CR 45 speed ! control-brake .
CR 90 speed ! control-brake .
CR
50 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
200 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .

\
\ Tipping Examples
\
lingvar service \ level
-2 -1 0 5 member poor
0 5 5 10 member acceptable
5 10 11 12 member amazing

lingvar quality \ of food
-2 -1 0 5 member bad
0 5 5 10 member decent
5 10 11 12 member great

lingvar tip \ percentage
0 singleton low
13 singleton medium
25 singleton high

variable count
: tipping-rules
0 tip ! 0 count !
<IF> service <IS> amazing <THEN> 1 .fired count ++ tip <IS> high <END> quality <IS> great <THEN> 2 .fired count ++ tip <IS> high <END>
<IF> service <IS> acceptable <THEN> 3 .fired count ++ tip <IS> medium <END> service <IS> poor <AND> quality <IS> poor <THEN> 4 .fired count ++ tip <IS> low <END>
;
' sum is aggregate
: calc-tip tipping-rules tip @ count @ / ;

CR CR .( Tipping example)
CR 6 quality ! 9 service ! calc-tip .
CR 6 quality ! 8 service ! calc-tip .
CR 9 quality ! 4 service ! calc-tip .
CR 3 quality ! 3 service ! calc-tip .

\
\ Example - fan control
\
lingvar temperature
-21 -20 20 40 member cool
20 40 40 50 member warm
40 60 120 121 member hot

lingvar fan-speed
30 singleton slow
60 singleton medium
90 singleton fast

: fan-rules
0 fan-speed !
<IF> temperature <IS> cool <THEN> 1 .fired fan-speed <IS> slow <END> temperature <IS> warm <THEN> 2 .fired fan-speed <IS> medium <END> temperature <IS> hot <THEN> 3 .fired fan-speed <IS> fast <END>
;

: control-fan fan-rules fan-speed @ ;
: clip-input cool p1 hot p4 WITHIN NOT ABORT" Input out of range!" ;
: control2 clip-input temperature ! control-fan ;

CR CR .( Fan Speed control)
: test 80 0 DO CR I 3 .r space I temperature ! control-fan space 3 .r LOOP ; test

Hi,
I tried to read your program. I see that you have used integers. Me I prefer floats.
You can find a version of fuzzy logic in forth in "forth dimension magazine" Volume 18 N° 6 (written by Rick VanNorman).
You can find it at : http://forth.org/fd/contents.html.

I tested your program, it worked for the 1st and 3rd examples, but the 2nd example does'nt work because the word ++ is not defined in the gforth I use.

In executing the fuzzy system program (fuzzy logic regulator) we are interested in the output not the rules that were fired, but for purposes of debugging we can add the display of the fired rules, and just for this.

Have fun and good discoveries


--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Ahmed MELAHI schrieb am Mittwoch, 11. Oktober 2023 um 20:50:53 UTC+2:

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :
I tried to read your program. I see that you have used integers. Me I prefer floats.

Practically all real-life applications of fuzzy logic are in control of technical systems,
eg motors or chemical reactors.

There you often don't have floats available. So binary FL has its important place.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le jeudi 12 octobre 2023 à 08:02:07 UTC, minforth a écrit :

Ahmed MELAHI schrieb am Mittwoch, 11. Oktober 2023 um 20:50:53 UTC+2:

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :
I tried to read your program. I see that you have used integers. Me I prefer floats.

Practically all real-life applications of fuzzy logic are in control of technical systems,
eg motors or chemical reactors.

There you often don't have floats available. So binary FL has its important place.

Agreed.

But for simulations of fuzzy logic control systems, I prefer floats.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Thursday, October 12, 2023 at 12:20:27 PM UTC+4, Ahmed MELAHI wrote:

Le jeudi 12 octobre 2023 à 08:02:07 UTC, minforth a écrit :

Ahmed MELAHI schrieb am Mittwoch, 11. Oktober 2023 um 20:50:53 UTC+2:

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :
I tried to read your program. I see that you have used integers. Me I prefer floats.

Practically all real-life applications of fuzzy logic are in control of technical systems,
eg motors or chemical reactors.

There you often don't have floats available. So binary FL has its important place.

Agreed.

But for simulations of fuzzy logic control systems, I prefer floats.

Hi,

sure both are fine. my goal was concept realization without distraction with FP details. Moreover, if you dabble with Forth in micro controllers, most are FP-less (if that was a word!) but again on PC it is doable in both.

++ word is incrementing by one
: ++ ( a -- ) 1 SWAP +! ;

Regards,

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le jeudi 12 octobre 2023 à 13:27:08 UTC, Ala'a a écrit :

On Thursday, October 12, 2023 at 12:20:27 PM UTC+4, Ahmed MELAHI wrote:

Le jeudi 12 octobre 2023 à 08:02:07 UTC, minforth a écrit :

Ahmed MELAHI schrieb am Mittwoch, 11. Oktober 2023 um 20:50:53 UTC+2:

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :
I tried to read your program. I see that you have used integers. Me I prefer floats.

Practically all real-life applications of fuzzy logic are in control of technical systems,
eg motors or chemical reactors.

There you often don't have floats available. So binary FL has its important place.

Agreed.

But for simulations of fuzzy logic control systems, I prefer floats.

Hi,

sure both are fine. my goal was concept realization without distraction with FP details. Moreover, if you dabble with Forth in micro controllers, most are FP-less (if that was a word!) but again on PC it is doable in both.

Agreed.

++ word is incrementing by one
: ++ ( a -- ) 1 SWAP +! ;

Now, Example 2 works.

Regards,

Salutations

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 11 octobre 2023 à 16:45:36 UTC, Ala'a a écrit :

I was having fun learning FL, still do, and thought to share what I understood till now. so here is my take as a newbie to FL. I hope i did not make too many mistakes (especially any conceptual ones :) ). The formatting my be messed up.

VOCABULARY FuzzyLogic21 ALSO FuzzyLogic21 DEFINITIONS
\ Assume trapizoidal inputs
\ Assume range is bounded by p1 and p4
\ Assume singleton outputs
\ no verification of rules being complete (covering all cases) is done in this implementation
: lingvar VARIABLE ; \ lingustic variable (input or output is a variable here)
: member ( p1 p2 p3 p3 --) CREATE >R SWAP ROT , , , R> , ; \ define input m.ship. function, simple without linking lingvar
: p1 @ ; : p2 CELL+ @ ; : p3 2 CELLS + @ ; : p4 3 CELLS + @ ;
: pts ( mem -- p1 p2 p3 p4 ) >R R@ p1 R@ p2 R@ p3 R> p4 ;
: singleton ( val -- ) CONSTANT ; \ 'member' word could be used with p1, but seemed a waste!
: seg1 ( mem -- p1 p2 ) >R R@ p1 1+ R> p2 1- ; \ ascending line
: seg2 ( mem -- p2 p3 ) >R R@ p2 R> p3 ; \ horizontal line
: seg3 ( mem -- p3 p4 ) >R R@ p3 1+ R> p4 1- ; \ desc. line
1000 VALUE res \ resolution of the 1==1000 value membership
: interpo ( xm y1 y2 -- ym ) >R TUCK - res * SWAP R> - / ABS ; \ interpolate. used for both asc. and desc. lines.
: ]clip[ ( val p1 p2 -- clipped ) ROT DUP >R -ROT 1+ WITHIN ABS R> * ; \ val or zero if out of range
: fuzz ( crisp mem -- fz1 fz2 fz3 ) \ trapizoidal interpolation. is it possible to improve this?
2DUP seg1 ]clip[ IF 2DUP seg1 interpo ELSE 0 THEN -ROT
2DUP seg2 ]clip[ IF res ELSE 0 THEN -ROT
2DUP seg3 ]clip[ IF seg3 SWAP interpo ELSE 2DROP 0 THEN ;

DEFER aggregate
: maximize ( val var -- ) TUCK @ MAX SWAP ! ;
: minimize ( val var -- ) TUCK @ MIN SWAP ! ;
: sum ( val var -- ) +! ;
' maximize IS aggregate
: defuz ( fuz-val lingvar singleton -- ) ROT res */ SWAP aggregate ;

\ Rules compilation
SYNONYM ` POSTPONE
DEFER <IS> IMMEDIATE
DEFER <AND> IMMEDIATE
: nop ;
: compile-at ` @ ;
: compile-fuzz-min ` fuzz ` + ` + ` min ; ' compile-fuzz-min IS <AND>
: compile-<and>-defuz ` defuz ` DUP ;
: antecedent-scope ['] compile-at IS <IS> ['] compile-fuzz-min IS <AND> ;
: consequence-scope ['] nop IS <IS> ['] compile-<and>-defuz IS <AND> ;
: <IF> ` res ` 1+ antecedent-scope ; IMMEDIATE \ max fuz is res, thus 'res 1+' will do with MIN
: <THEN> ` <AND> ` DUP ` IF ` DUP consequence-scope ; IMMEDIATE
: <END> ` defuz ` THEN ` DROP ; IMMEDIATE
: .fired ." Rule " . ." fired! " ;

\
\ Example - car brakes
\
lingvar speed \ in KM\H
0 10 40 50 member low
40 60 80 100 member medium
80 100 320 325 member high

lingvar distance \ in meters
-1 0 20 50 member close
30 60 80 100 member near
80 110 1000 1005 member far

lingvar brake \ measured in N or poundal (this example is illustrative rather than giving experience/measured forces)
0 singleton light
10 singleton moderate
30 singleton hard

: brake-rules
0 brake !
<IF> distance <IS> close <AND> speed <IS> high <THEN> 1 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> medium <THEN> 2 .fired brake <IS> hard <END>
<IF> distance <IS> close <AND> speed <IS> low <THEN> 3 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> high <THEN> 4 .fired brake <IS> hard <END>
<IF> distance <IS> near <AND> speed <IS> medium <THEN> 5 .fired brake <IS> moderate <END>
<IF> distance <IS> near <AND> speed <IS> low <THEN> 6 .fired brake <IS> light <END>
<IF> distance <IS> far <THEN> 7 .fired brake <IS> light <END>
;

: control-brake ( -- b ) brake-rules brake @ ;

CR CR .( Car Brakes example) CR
2 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
50 distance !
CR 45 speed ! control-brake .
CR 90 speed ! control-brake .
CR
50 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .
CR
200 distance !
CR 15 speed ! control-brake .
CR 70 speed ! control-brake .
CR 100 speed ! control-brake .

\
\ Tipping Examples
\
lingvar service \ level
-2 -1 0 5 member poor
0 5 5 10 member acceptable
5 10 11 12 member amazing

lingvar quality \ of food
-2 -1 0 5 member bad
0 5 5 10 member decent
5 10 11 12 member great

lingvar tip \ percentage
0 singleton low
13 singleton medium
25 singleton high

variable count
: tipping-rules
0 tip ! 0 count !
<IF> service <IS> amazing <THEN> 1 .fired count ++ tip <IS> high <END> quality <IS> great <THEN> 2 .fired count ++ tip <IS> high <END>
<IF> service <IS> acceptable <THEN> 3 .fired count ++ tip <IS> medium <END> service <IS> poor <AND> quality <IS> poor <THEN> 4 .fired count ++ tip <IS> low <END>
;
' sum is aggregate
: calc-tip tipping-rules tip @ count @ / ;

CR CR .( Tipping example)
CR 6 quality ! 9 service ! calc-tip .
CR 6 quality ! 8 service ! calc-tip .
CR 9 quality ! 4 service ! calc-tip .
CR 3 quality ! 3 service ! calc-tip .

\
\ Example - fan control
\
lingvar temperature
-21 -20 20 40 member cool
20 40 40 50 member warm
40 60 120 121 member hot

lingvar fan-speed
30 singleton slow
60 singleton medium
90 singleton fast

: fan-rules
0 fan-speed !
<IF> temperature <IS> cool <THEN> 1 .fired fan-speed <IS> slow <END> temperature <IS> warm <THEN> 2 .fired fan-speed <IS> medium <END> temperature <IS> hot <THEN> 3 .fired fan-speed <IS> fast <END>
;

: control-fan fan-rules fan-speed @ ;
: clip-input cool p1 hot p4 WITHIN NOT ABORT" Input out of range!" ;
: control2 clip-input temperature ! control-fan ;

CR CR .( Fan Speed control)
: test 80 0 DO CR I 3 .r space I temperature ! control-fan space 3 .r LOOP ; test

Hi again,

I took another look at your program, I have a question:

the formula used for defuzzification must be:

y* = ( sum(mfi(x) * yi))/(sum(mfi(x)))

the summation is over i = 1...R, R is the number of rules
and
where x is the input (or inputs),
yi the singleton used in the consequence of the i th rule
mfi is the membership function resulting from the antecedent or the i th rule an y* is the output

have you used this formula, because I can't see the division by (sum(mfi(x))).

Best regards

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Hi Ahmed,

Your observation about the missing division is a near hit :)

Kindly correct me if I am wrong. There is aggregation and then Defuzzification. Aggregation result is sets, Defuzzification result is crisp values. Both of these are kind of intermingled (implemented) in 'defuz' and 'aggregate' words. The default of the
deffered 'aggregate' is 'maximize'. however, for the tipping example it was 'sum' and then with the help of 'count' variable I cheated and did (my) average by dividing by the sum of count rather than sum of fired rules' antecedents values.

Regards,

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le jeudi 12 octobre 2023 à 18:58:26 UTC, Ala'a a écrit :

Hi Ahmed,

Your observation about the missing division is a near hit :)

Kindly correct me if I am wrong. There is aggregation and then Defuzzification. Aggregation result is sets, Defuzzification result is crisp values. Both of these are kind of intermingled (implemented) in 'defuz' and 'aggregate' words. The default of

the deffered 'aggregate' is 'maximize'. however, for the tipping example it was 'sum' and then with the help of 'count' variable I cheated and did (my) average by dividing by the sum of count rather than sum of fired rules' antecedents values.

Regards,

Hi,
Your program is ok for just these use cases (by construction, your trapezoidal functions sums to 1 (full grade) for any input x) and the result is good because you divide by 1 (full grade) (ie sum(mfi(x))=fullgrade).
but in general, in fuzzy logic, we haven't that condition fulfilled all the time and the membership functions are with different forms and parameters and perhaps can be tuned by learning algorithms (see neuro-fuzzy systems and control).

another remark:
for the example n°1, in the word brake-rules, these fuzzy propositions are caluclated and recalculated again and again at runtime. but we need just one calulation and use the result several times (we haven't to recalculate them):
distance <IS> close, calculated 3 times
distance <IS> near, calculated 3 times
...
(N.B. I have used the same recalcualtions in the first psot of the fuzzy system program see:
https://groups.google.com/g/comp.lang.forth/c/KkXtmylnibE
)
but I mdified it to avoid these recalculations in this thread.

I think, the best way is to separate the stages: fuzzification, inference (fuzzy conjunction, fuzzy implication and fuzzy aggregation), then defuzzification at the end.
the inference use the rule base to get a function (distribution) (here i noted it mfi(x) for the i th rule.
the deffuzification calculate a crisp (numeric) output using this distribution. And there several methods.

Bye, Enjoy.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)