[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {
    ---------------------------------------------------------------------------
    KW>WV>Got some german pascal code on this subject. It seems to implement a
      >  >.... (Bit large to send if nobody's interested).

    KW>Can you extract the specifically fuzzy logic parts?
      >---
    No (didnt know where to look, how doesfuzzy pascal look :-) ) so here's
    the complete program taken from a german magazine
    }

    UNIT Fuzzy;
    INTERFACE

    Uses Graph,Crt,Dos;

    CONST
      Infinity  = 1.7e38;
      NoRules   = NIL;
      ValueCol  = LightMagenta;

    TYPE
      NameStr       = String[20];
      (* verschiedene Operatortypen *)
      Inference     = FUNCTION(Set1,Set2,Set3:Real):real;

      FuzzySetList  = ^FuzzySet;
      FuzzyVarList  = ^FuzzyVar;
      FuzzyRuleList = ^FuzzyRule;

      FuzzySet      = Object
                        SetName : NameStr;       (* Mengenbenzeichner    *)
                        StartAt,                 (* Startwert            *)
                        HighAt,                  (* Maximum bei ...      *)
                        EndAt   : Real;          (* Endwert              *)
                        Next    : FuzzySetList;
                        Color   : Byte;
                        MemberShip : Real;       (* aktueller Wert der   *)
                                                 (* Zugeh�rigkeit        *)
                        Rules   : FuzzyRuleList; (* Regelliste f�r diese *)
                                                 (* unscharfe Menge      *)
                        Constructor Init( InitName : NameStr;
                                          InitStart, InitHigh,
                                          InitEnd  : Real;
                                          InitColor: Byte);
                        PROCEDURE Append( InitName : NameStr;
                                          InitStart, InitHigh,
                                          InitEnd  : Real;
                                          InitColor: Byte);
                        FUNCTION  GetMemberShip(LingVal : Real):Real;
                        PROCEDURE DefineRule( InfType : Inference;
                                              Var1    : FuzzyVarList;
                                              SetName1: NameStr;
                                              Var2    : FuzzyVarList;
                                              SetName2: NameStr);
                      END;

      FuzzyVar        = Object
                        VarName   : NameStr;       (* Variablenname        *)
                        PosX,PosY : WORD;          (* Bildschirmkoordinaten*)
                        StartValue,                (* Anfang und Ende des  *)
                        EndValue,                  (* Koordinatensystems   *)
                        Scale     : Real;          (* Maástabsfaktor       *)
                        UnitStr   : NameStr;       (* Einheit, z.B. øC     *)
                        CurrentVal: Real;          (* aktueller Wert       *)
                        FuzzySets : FuzzySetList;  (* Liste der unscharfen *)
                                                   (* Mengen               *)
                        Result,BackGround :
                           ARRAY[1..5] OF PointType;
                        Constructor Init( InitName    : NameStr;
                                          InitX,InitY : WORD;
                                          Sections    : Byte;
                                          InitStart,InitEnd,
                                          InitValue   : Real;
                                          InitUnit    : NameStr);
                        PROCEDURE  CoordSystem(Sections : Byte);
                        FUNCTION   RealToCoord(r:Real):WORD;
                        PROCEDURE  DisplaySets;
                        PROCEDURE  DisplayValue(TextColor:WORD);
                        PROCEDURE  DisplayResultSets;
                        PROCEDURE  Change(Diff : Real);
                        FUNCTION   GetMemberShipOf(Name : NameStr):Real;
                        PROCEDURE  Infer;
                        PROCEDURE  DeFuzzy;
                        PROCEDURE  DefineSet( InitName : NameStr;
                                              InitStart, InitHigh,
                                              InitEnd  : Real;
                                              InitColor: Byte);
                        PROCEDURE  DefineRule(SetName  : NameStr;
                                              InfType  : Inference;
                                              Var1     : FuzzyVarList;
                                              SetName1 : NameStr;
                                              Var2     : FuzzyVarList;
                                              SetName2 : NameStr);
                      END;

      FuzzyRule       = Object
                        Inf_Type   : Inference;       (* Operatortyp       *)
                        Var1, Var2 : FuzzyVarList;    (* Eingangsvariablen *)
                        SetName1, SetName2 : NameStr; (* Eingangsmengen    *)
                        Next       : FuzzyRuleList;
                        Constructor Init( InitInf    : Inference;
                                          InitVar1   : FuzzyVarList;
                                          InitName1  : NameStr;
                                          InitVar2   : FuzzyVarList;
                                          InitName2  : NameStr);
                        PROCEDURE Append( InitInf    : Inference;
                                          InitVar1   : FuzzyVarList;
                                          InitName1  : NameStr;
                                          InitVar2   : FuzzyVarList;
                                          InitName2  : NameStr);
                        FUNCTION Infer(HomeSetValue:Real):Real;
                      END;

    Procedure Buzz;
    procedure error(message : string);

    function Max( A, B: Real ): Real;
    function Min( A, B: Real ): Real;

    FUNCTION AND_MaxMin(Set1,Set2,Set3:Real):Real;
    FUNCTION OR_MaxMax(Set1,Set2,Set3:Real):Real;

    VAR
      DisplayOn : BOOLEAN; (* Anzeige der unscharfen Mengen ein/aus *)
      Regs : Registers;
      ResultCol : WORD;

    Implementation

    CONST OffSet = 20;

    VAR   Buffer : String;

    PROCEDURE Buzz;
    BEGIN sound(30); Delay(100); NoSound; END;

    procedure error(message : string);
    begin
      CloseGraph; writeln(message); halt
    end;

    function Max( A, B: Real ): Real;
    begin
      if A < B then Max := B else Max := A;
    end;

    function Min( A, B: Real ): Real;
    begin
      if A > B then Min := B else Min := A;
    end;

    (* MaxMin-Operator f�r UND *)
    FUNCTION AND_MaxMin(Set1,Set2,Set3:Real):Real;
    BEGIN
      AND_MaxMin:=Max(Set1,Min(Set2,Set3))
    END;

    (* MaxMax-Operator f�r ODER *)
    FUNCTION OR_MaxMax(Set1,Set2,Set3:Real):Real;
    BEGIN
      OR_MaxMax:=Max(Set1,Max(Set2,Set3))
    END;

    CONSTRUCTOR FuzzySet.Init;

    BEGIN
      SetName := InitName;
      StartAt := InitStart;
      HighAt  := InitHigh;
      EndAt   := InitEnd;
      Color   := InitColor;
      Next    := NIL;
      Rules:= NoRules;
      MemberShip := 0;
    END;

    PROCEDURE FuzzySet.Append;
    BEGIN
      IF Next=NIL
      THEN New(Next,Init(InitName,InitStart,InitHigh,InitEnd,InitColor))
      ELSE Next^.Append(InitName,InitStart,InitHigh,InitEnd,InitColor)
    END;

    FUNCTION FuzzySet.GetMemberShip;
    BEGIN
      IF (LingVal<=StartAt) THEN GetMemberShip:=0
      ELSE IF (LingVal>=EndAt) THEN GetMemberShip:=0
      ELSE
      BEGIN
        IF ((StartAt=-Infinity) AND (LingVal<=HighAt))
        OR ((EndAt=Infinity) AND (LingVal>=HighAt)) THEN GetMemberShip:=1
        ELSE IF (LingVal<=HighAt)
             THEN GetMemberShip:=(LingVal-StartAt)/(HighAt-StartAt)
        ELSE GetMemberShip:=1-(LingVal-HighAt)/(EndAt-HighAt)
      END
    END;

    PROCEDURE FuzzySet.DefineRule;
    BEGIN
      IF Rules=NoRules THEN
         Rules:= new(FuzzyRuleList,
                 Init(InfType,Var1,SetName1,Var2,SetName2))
      ELSE Rules^.Append(InfType,Var1,SetName1,Var2,SetName2)
    END;

    CONSTRUCTOR FuzzyVar.Init;
    BEGIN
      VarName:=InitName;
      PosX:=InitX;
      PosY:=InitY;
      StartValue:=InitStart;
      EndValue  :=InitEnd;
      Scale     :=210/(EndValue-StartValue);
      UnitStr   :=InitUnit;
      CurrentVal:=InitValue;
      CoordSystem(Sections);
      FuzzySets      :=NIL;
      BackGround[1].x:=PosX+1;   BackGround[1].y:=PosY+100;
      BackGround[2].x:=PosX+1;   BackGround[2].y:=PosY+20;
      BackGround[3].x:=PosX+250; BackGround[3].y:=PosY+20;
      BackGround[4].x:=PosX+250; BackGround[4].y:=PosY+100;
      BackGround[5]:=BackGround[1];
    END;

    FUNCTION FuzzyVar.RealToCoord(r:Real):WORD;
    BEGIN
      RealToCoord:=PosX+OffSet+Round((r-StartValue)*Scale);
    END;

    PROCEDURE FuzzyVar.CoordSystem(Sections: BYTE);
    (* zeichnet ein Koordinatensystem            *)
    (* PosX, PosY bestimmen die linke obere Ecke *)
    VAR N         : Byte;
        MarkerX   : WORD;
        Increment : Real;
    BEGIN
      SetColor(White);
      SetTextJustify(CenterText,CenterText);
      Line( PosX, PosY, PosX, PosY+103 );
      Line( PosX-3, PosY+100, PosX+250, PosY+100 );
      Line( PosX, PosY+20, PosX-3, PosY+20 );
      OutTextXY( PosX-15, PosY+20,  '1' );
      OutTextXY( PosX-15, PosY+100, '0' );
      Increment :=(EndValue-StartValue)/(Sections-1);
      for N := 0 to Sections-1 do
      begin
        MarkerX:=RealToCoord(StartValue+N*Increment);
        Line(MarkerX,PosY+101,MarkerX,PosY+103);
        Str(Round(StartValue + N * Increment), Buffer );
        OutTextXY(MarkerX, PosY+113, Buffer );
      end;
      OutTextXY( PosX + 270, PosY + 113, '['+UnitStr+']');
      SetColor(Red);
      SetTextJustify(LeftText,CenterText);
      OutTextXY( PosX + 20, PosY + 140,VarName+' = ');
      OutTextXY( PosX + 200,PosY + 140,UnitStr);
    END;

    PROCEDURE FuzzyVar.DisplayValue;

    BEGIN
      SetWriteMode(XORPut);
      SetColor(ValueCol);
      IF (CurrentVal>=StartValue) AND (CurrentVal<=EndValue)
      THEN Line(RealToCoord(CurrentVal),PosY+20,
           RealToCoord(CurrentVal),PosY+100);
      SetColor(TextColor);
      SetTextJustify(RightText,CenterText);
      Str(CurrentVal : 7 : 2, Buffer );
      OutTextXY( PosX+190, PosY + 140 , Buffer );
    END;

    PROCEDURE FuzzyVar.Change;
    BEGIN
      IF (CurrentVal+Diff>=StartValue) AND (CurrentVal+Diff<=EndValue)
      THEN
      BEGIN
        DisplayValue(0);
        CurrentVal:=CurrentVal+Diff;
        DisplayValue(ValueCol);
      END
      ELSE (* Bereichsgrenzen �berschritten *)
      Buzz;
    END;

    PROCEDURE FuzzyVar.DisplaySets;
    (* zeigt die unscharfen Mengen einer Variablen an *)
    VAR SetPtr : FuzzySetList;
    BEGIN
      SetPtr:=FuzzySets;
      WHILE SetPtr<>NIL DO WITH SetPtr^ DO
      BEGIN
        SetColor(Color);
        IF StartAt=-Infinity THEN SetTextJustify(RightText,CenterText)
        ELSE IF EndAt=Infinity THEN SetTextJustify(LeftText,CenterText)
        ELSE SetTextJustify(CenterText,CenterText);
        OutTextXY(RealToCoord(HighAt),PosY+10,SetName);
        IF StartAt=-Infinity
        THEN Line(PosX,PosY+20,RealToCoord(HighAt),PosY+20)
        ELSE Line( RealToCoord(StartAt),PosY+100,
                   RealToCoord(HighAt),PosY+20);
        IF EndAt=Infinity
        THEN Line(RealToCoord(HighAt),PosY+20,PosX+250,PosY+20)
        ELSE Line(RealToCoord(HighAt),PosY+20,RealToCoord(EndAt),PosY+100);
        SetPtr:=Next
      END
    END;

    FUNCTION FuzzyVar.GetMemberShipOf;
    VAR SetPtr : FuzzySetList;
    BEGIN
      SetPtr:=FuzzySets;
      WHILE (SetPtr<>NIL) AND (SetPtr^.SetName<>Name) DO SetPtr:=SetPtr^.Next;
      IF SetPtr=NIL THEN error( 'Menge '+Name+' ist in der Ling. Variablen '
                                +VarName+' nicht definiert!')
      ELSE GetMemberShipOf:=SetPtr^.GetMemberShip(CurrentVal)
    END;

    PROCEDURE  FuzzyVar.DisplayResultSets;
    VAR SetPtr : FuzzySetList;
    BEGIN
      SetWriteMode(CopyPut);
      SetColor(ResultCol);
      SetPtr:=FuzzySets;
      WHILE SetPtr<>NIL DO WITH SetPtr^ DO
      BEGIN
        IF MemberShip>0 THEN
        BEGIN
          IF StartAt<=StartValue THEN Result[1].x := RealToCoord(StartValue)
          ELSE Result[1].x := RealToCoord(StartAt);
          Result[1].y := PosY+99;
          Result[2].x := RealToCoord(HighAt);
          Result[2].y := PosY+99 - Round(MemberShip*79);
          IF EndAt>=EndValue THEN Result[3].x := RealToCoord(EndValue)
          ELSE Result[3].x:= RealToCoord(EndAt);
          Result[3].y := PosY+99;
          Result[4]   := Result[1];
          FillPoly( 4, Result )
        END;
        SetPtr:=next
      END
    END;

    PROCEDURE FuzzyVar.Infer; (* alle Regeln antriggern *)
    VAR
      SetPtr : FuzzySetList;
      RulePtr: FuzzyRuleList;
    BEGIN
      SetPtr:=FuzzySets;
      WHILE SetPtr<>NIL DO WITH SetPtr^ DO
      BEGIN
        RulePtr:=Rules;
        MemberShip:=0;
        WHILE RulePtr<>NIL DO
        BEGIN
          MemberShip:=RulePtr^.Infer(MemberShip);
          RulePtr:=RulePtr^.Next
        END;
        SetPtr:=Next
      END
    END; (* FuzzyVar.Infer *)

    PROCEDURE FuzzyVar.Defuzzy;
    (* Bestimmung des Fl�chenschwerpunktes der unscharfen *)
    (* Ergebnismenge durch Ausz�hlen der Pixel            *)

    (* Raster der Rechnergeschwindigkeit anpassen *)
    (* gr�áte Rechengenauigkeit bei Raster=1      *)
    CONST Raster = 16;
    VAR
      X,Y,XOffSet : WORD;
      Zaehler, Nenner: Real;
    BEGIN
      DisplayValue(Black);
      SetFillStyle(SolidFill, Black);
      SetColor(Black);
      FillPoly(5, BackGround);
      SetFillStyle(SolidFill, ResultCol);
      IF DisplayOn
      THEN DisplaySets; (* verzerrt das Ergebnis auf Hercules *)
      DisplayResultSets;
      Zaehler :=0;
      Nenner :=0;
      XOffset :=PosX+20;
      for X := 0 TO 210 DIV Raster DO (* Fl�chenschwerpunkt bestimmen *)
       for Y := PosY + 20 to PosY + 100 do
       if GetPixel(Raster*X+XOffSet,Y) = ResultCol then
       begin
         Nenner:=Nenner+1;
         Zaehler:=Zaehler+Raster*X;
       end;
      IF Nenner=0 THEN CurrentVal:=0
      ELSE CurrentVal :=Zaehler/Nenner/Scale+StartValue;
      DisplayValue(ResultCol)
    end;

    PROCEDURE FuzzyVar.DefineRule;
    VAR SetPtr : FuzzySetList;
    BEGIN
      SetPtr:=FuzzySets;
      WHILE (SetPtr<>NIL) AND (SetPtr^.SetName<>SetName)
      DO SetPtr:=SetPtr^.Next;
      IF SetPtr=NIL THEN error( 'Menge '+SetName+' ist in der Ling. '+
                                'Variablen '+VarName+' nicht definiert!')
      ELSE SetPtr^.DefineRule(InfType,Var1,SetName1,Var2,SetName2)
    END;

    PROCEDURE FuzzyVar.DefineSet;
    BEGIN
      IF FuzzySets = NIL
      THEN FuzzySets:= new(FuzzySetList,
                       Init(InitName,InitStart,InitHigh,InitEnd,InitColor))
      ELSE FuzzySets^.Append(InitName,InitStart,InitHigh,InitEnd,InitColor)
    END;

    CONSTRUCTOR FuzzyRule.Init;
    BEGIN
      Inf_Type :=InitInf;
      Var1     :=InitVar1;
      Var2     :=InitVar2;
      SetName1 :=InitName1;
      SetName2 :=InitName2;
      Next     :=NIL
    END;

    PROCEDURE FuzzyRule.Append;
    BEGIN
      IF Next=NIL
      THEN New(Next,Init(InitInf,InitVar1,InitName1,InitVar1,InitName2))
      ELSE Next^.Append(InitInf,InitVar1,InitName1,InitVar2,InitName2)
    END;

    FUNCTION FuzzyRule.Infer; (* einzelne Regel abarbeiten *)
    BEGIN
      Infer:=Inf_Type(HomeSetValue, Var1^.GetMemberShipOf(SetName1),
                                    Var2^.GetMemberShipOf(SetName2));
    END;

    BEGIN (* Fuzzy-Logic-Unit *)
      (* Test auf Herculeskarte wg. Farbe f�r Ergebnismengen *)
      Regs.ah:=15;
      Intr($10,Regs);
      IF Regs.AL=7 THEN (* Hercules-Karte *)
      BEGIN
        ResultCol :=Blue;
        DisplayOn :=FALSE; (* siehe Artikel c't 3/91 *)
      END
      ELSE (* EGA-/VGA-Karte *)
      BEGIN
        ResultCol :=LightGray;
        DisplayOn :=TRUE
      END
    END.

    { --------------------------    DEMO PROGRAM   ------------------------ }
    {             I HOPE THAT YOU CAN READ GERMAN !!                        }

    program fuzzy_inf_demo; (* c't 3/91 / it / C.v.Altrock, RWTH Aachen *)
    uses Graph, Crt, Fuzzy;
    type InputType = (temp,press,valve);
    var
      GraphDriver, GraphMode, RK : Integer;
      StepWidth     : Array[InputType] OF Real;
      i,Input       : InputType;
      Ch            : Char;
      FuzzyVars     : ARRAY[InputType] of FuzzyVarList;

    PROCEDURE InitGrafix;
    (* Grafikmodus initialisieren und Hilfetexte schreiben *)
    BEGIN
      GraphDriver := Detect;
      InitGraph(GraphDriver,GraphMode,'\turbo\tp');
      SetTextJustify(CenterText,CenterText);
      OutTextXY( GetMaxX DIV 2, 10, 'Demonstration der MAX-PROD-'
                 +'Inferenz (c''t 3/91 / C.v.Altrock, RWTH Aachen)');
      OutTextXY( 500, 50, 'Eingabe Temperatur: ['+Chr(24)+']' );
      OutTextXY( 500, 65, 'Eingabe Druck: ['+Chr(25)+']' );
      OutTextXY( 500, 80, 'Erh�hen: ['+Chr(26)+']' );
      OutTextXY( 500, 95, 'Vermindern: ['+Chr(27)+']' );
      OutTextXY( 500, 110, 'Schrittweite: [Bild'+Chr(24)+Chr(25)+']' );
      Rectangle(400,40,600,120);
    END; (* InitGrafix *)

    begin (* main *)
      InitGrafix;

      (* Definition der linguistischen Variablen "Temperatur" *)
      FuzzyVars[temp]:= new(FuzzyVarList,
                        Init('Temperatur',20,30,7,400,1000,650,'øC'));
      WITH FuzzyVars[temp]^ DO
      BEGIN
        (* Definition und Anzeige der Fuzzy Sets *)
        DefineSet('niedrig',-Infinity,500,650,Blue);
        DefineSet('mittel',500,650,800,LightGreen);
        DefineSet('hoch',650,800,950,Red);
        DefineSet('sehr_hoch',800,950,Infinity,Yellow);
        DisplaySets; DisplayValue(ValueCol);
      END;

      (* Definition der linguistischen Variablen "Druck" *)
      FuzzyVars[press]:= new(FuzzyVarList,
                         Init('Druck',20,210,4,38,41,40,'bar'));
      WITH FuzzyVars[press]^ DO
      BEGIN
        (* Definition und Anzeige der Fuzzy Sets *)
        DefineSet('unter_normal',-Infinity,39,40,Blue);
        DefineSet('normal',39,40,41,LightGreen);
        DefineSet('�ber_normal',40,41,Infinity,Red);
        DisplaySets; DisplayValue(ValueCol);
      END;

      (* Definition der linguistischen Variablen "Methanventil" *)
      FuzzyVars[valve]:= new(FuzzyVarList,
                         Init('Methanventil',340,170,7,0,12,0,'m3/h'));
      WITH FuzzyVars[valve]^ DO
      BEGIN
        (* Definition der Fuzzy Sets *)
        DefineSet('gedrosselt',-Infinity,0,4,Blue);
        DefineSet('halboffen',0,4,8,Green);
        DefineSet('mittel',4,8,12,LightGreen);
        DefineSet('offen',8,12,Infinity,Yellow);
        (* Definition der Inferenzregeln *)
        (* 1 IF Temperatur ist niedrig OR Druck ist unter_normal
             THEN Methanventil ist offen                         *)
        DefineRule('offen',OR_MaxMax, FuzzyVars[temp],'niedrig',
                                      FuzzyVars[press],'unter_normal');
        (* 2 IF Temperatur ist sehr_hoch OR Druck ist �ber_normal
             THEN Methanventil ist gedrosselt                    *)
        DefineRule('gedrosselt',OR_MaxMax, FuzzyVars[temp],'sehr_hoch',
                                           FuzzyVars[press],'�ber_normal');
        (* 3 IF Temperatur ist hoch AND Druck ist normal
             THEN Methanventil ist halboffen                     *)
        DefineRule('halboffen',AND_MaxMin, FuzzyVars[temp],'hoch',
                                           FuzzyVars[press],'normal');
        (* 4 IF Temperatur ist mittel AND Druck ist normal
             THEN Methanventil ist mittel                        *)
        DefineRule('mittel',AND_MaxMin, FuzzyVars[temp],'mittel',
                                           FuzzyVars[press],'normal');
        IF DisplayOn THEN DisplaySets;
        DisplayValue(ValueCol);
        Infer;
        Defuzzy;
      END;

      SetColor( Red );
      OutTextXY( 540, 330, '(Resultat der Inferenz)' );
      (* Schrittweiten f�r Druck und Temperatur intitialisieren *)
      StepWidth[temp]:=25;
      StepWidth[press]:=0.25;

      Input:= temp;
      Ch := ReadKey;
      while Ch = #0 do
      begin
        RK := ord(ReadKey);
        if RK = 72 then input := temp
        else if RK = 80 then input := press
        else if (RK=73) then StepWidth[input]:=StepWidth[input] * 2
        else if (RK=81) then Stepwidth[input]:= StepWidth[input] / 2
        else if (RK=75) OR (RK=77) then
        begin
          (* 1. Eingangsvariable �ndern *)
          if (RK=75) then FuzzyVars[Input]^.Change(-StepWidth[input])
          ELSE FuzzyVars[Input]^.Change(StepWidth[input]);
          (* 2. Inferenz durchf�hren *)
          FuzzyVars[valve]^.Infer;
          (* 3. Ergebnismenge defuzzifizieren *)
          FuzzyVars[valve]^.Defuzzy
        end;
        Ch := ReadKey
      end;
      CloseGraph
    end.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]