[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 fr 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 fr UND *)
FUNCTION AND_MaxMin(Set1,Set2,Set3:Real):Real;
BEGIN
AND_MaxMin:=Max(Set1,Min(Set2,Set3))
END;
(* MaxMax-Operator fr 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 fr 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 fr 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 durchfhren *)
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]