Entwickler-Ecke

Open Source Units - Mathematical function parser


Sven - Mo 08.12.03 14:10
Titel: Mathematical function parser
Hier noch ein Parser von Mathematischen Funktionen:

Es kann z.B. folgender String verarbeitet werden:
2.34*(3.45+123)-Trunc(Cos(Rad(45)))/47


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
 
unit modParser;
{ Mathematical function parser : converts string expression to numerical result
  by Sven Laufersweiler <service@bettercad.de>
  version 1.1 , 14. Mai 2001
  If running in IDE, put break on exception off  !
}
interface
uses sysutils,stdctrls,classes,math,dialogs;

TYPE
EparserError=class(Exception);
Rparameters= record x,y,z:extended; end;
Const parameter:Rparameters=(x:1;y:1;z:1);
TYPE

TZMathEdit=class(TEdit)
private
  function getEvaluatedString:string;
public
  property TextValue:string read getEvaluatedString;
end;

function EvaluateToFloat(s0:string):extended;
Function GetEvaluationError:string;
procedure Register;

implementation

const  sopps:string=('+-*/^');
       Pi          = 3.1415926535897932384626433832795;
var EvaluationError:string;


procedure Register;
begin
  RegisterComponents('Samples', [TZMathEdit]);
end;
function evaluate(s0:string):extended;forward;

procedure matchbracket(var i:integer;s0:string);
   var j,len:integer;
begin 
  j:=1;len:=length(s0);
  repeat inc(i);
    if i>len then raise EparserError.Create('missing '')''');
    if s0[i]='(' then inc(j);
    if s0[i]=')' then dec(j);
    if j<0 then raise EparserError.Create('missing ''(''');
  until j=0;
end;

function getvalue(s0:string):extended;
begin
  if length(s0)<1 then raise EparserError.Create('syntax error');
  if length(s0)=1 then result:=StrToDbl(s0) else
  case s0[1] of
    'x':result:=parameter.x;
    'y':result:=parameter.y;
    'z':result:=parameter.z;
    else result:=StrToDbl(s0);
  end;
end;

function specialF(p1:integer;s0:string):extended;
var operstr: string;
    arg    : extended;
begin
   operstr:=copy(s0,1,p1-1);
   operstr := LowerCase(operstr);
   if s0[length(s0)]<>')' then EparserError.CreateFmt('incorrect syntax %s',[s0]);
   arg:=evaluate(copy(s0,p1+1,length(s0)-p1-1));
   if operstr = 'sin'    then result:=sin(arg)
   else if operstr = 'cos'    then result:=cos(arg)
   else if operstr = 'tan'    then result:=sin(arg)/cos(arg)
   else if operstr = 'cot'    then result:=cos(arg)/sin(arg)
   else if operstr = 'sec'    then result:=1/sin(arg)
   else if operstr = 'cosec'  then result:=1/cos(arg)
   else if operstr = 'arctan' then result:=arctan(arg)
   else if operstr = 'arccot' then result:=1/arctan(arg)
   else if operstr = 'arcsin' then result:=arcsin(arg)
   else if operstr = 'arccos' then result:=arccos(arg)
   else if operstr = 'log'    then result:=ln(arg)/ln(10)
   else if operstr = 'ln'     then result:=ln(arg)
   else if operstr = 'exp'    then result:=exp(arg)
   else if operstr = 'sqrt'   then result:=sqrt(arg)
   else if operstr = 'rad'    then result:=arg*Pi/180
   else if operstr = 'deg'    then result:=arg*180/Pi
   else if operstr = 'pi'     then result:=Pi
   else if operstr = 'round'  then result:=Round(arg)
   else if operstr = 'trunc'  then result:=Trunc(arg)
   {enter additional functions here}
   else raise EparserError.CreateFmt('unknown function %s',[s0]);
end;

function calculate(p1:integer;s0:string):extended;
   var v1,v2:extended;
begin
   v1:=evaluate(copy(s0,1,p1-1));
   v2:=evaluate(copy(s0,p1+1,length(s0)-p1));
   case s0[p1] of
     '+': result:=v1+v2;
     '-': result:=v1-v2;
     '/': result:=v1/v2;
     '*': result:=v1*v2;
     '^': result:=exp(v2*ln(v1));
     else raise EparserError.CreateFmt('invalid operation %s',[s0]);
   end;
end;

function getfirstopp(tot:integer;s0:string):integer;
  var i:integer;
begin
   if tot=0 then tot:=length(s0);
   for i:=1 to 5 do begin
     result:=pos(sopps[i],s0);
     if ((i<3) and (result>0)) then
       if ((result=1) or (pos(s0[result-1],sopps)>0)) then result:=0;
     if result>0 then if result<tot then exit;
   end;
   if result>tot then result:=0;
end;

function Evaluate(s0:string):extended;
   var p1,p2,q1:integer;
begin
   p1:=pos('(',s0);p2:=p1;
   if p2>0 then matchbracket(p2,s0);
   if p1=1 then begin
     if p2=length(s0) then begin
       delete(s0,p2,1);delete(s0,1,1);
       result:=evaluate(s0);
     end
     else result:=calculate(p2+1,s0);
     exit;
   end;   
   q1:=getfirstopp(p1,s0);
   if (p1+q1=0) then begin
     result:=getvalue(s0);
     exit;
   end;
   if q1<>0 then result:=calculate(q1,s0)
   else if length(s0)>p2 then result:=calculate(p2+1,s0)
   else result:=specialF(p1,s0);
end;

procedure Cleanup(var s0:string);
  var i:integer;
begin
  s0:=lowercase(s0);
  i:=pos(' ',s0);
  while i>0 do begin 
    delete(s0,i,1);
    i:=pos(' ',s0);
  end;
end;

function TZMathEdit.GetEvaluatedString:string;
  var s0:string;
begin    
  s0:=text;
  TRY
     cleanup(s0);
     result:=FloatToStr(Evaluate(s0));
  EXCEPT
     on e:exception do result:=e.message;
  END;
end;

function EvaluateToFloat(s0:string):extended;
begin
  TRY
     evaluationerror:='';
     Cleanup(s0);
     result:=Evaluate(s0);
  EXCEPT
     on e:exception do begin
       evaluationerror:=e.message;
       result:=0;
     end;
  END;
end;

Function GetEvaluationError:string;
begin
  result:=evaluationerror;
end;

end.


Und hier eine kurze Enführung:
TZMathedit Komponente: Installiert modParser.pas wie gehabt. Es erscheint auf der Palettenseite "Samples".
Die Benutzung erfolgt genau wie die von TEdit, es gibt jedoch eine zusätzliche Eigenschaft:
TextValue:string; enthält das Ergebnis des Ausdruckes in Text, oder eine fehlermeldung.

Beispiel:
Setze TZMathEdit auf einer Form ab, dazu ein TLabel. In dessen OnChange Ereignisbehandlungsroutine schreibe folgendes:
Label1.Caption:=ZMathEdit1.TextValue;

Alternativ kann man auch auf die Einbindung der Komponente auf einer Form verzichten und die funktion EvaluateToFloat(s0:string):extended; direkt verwenden. Diese Funktion sollte nur zusammen mit GetEvaluationError:string; verwendet werden, ist aber nicht unbedingt erforderlich
Beispiel:
value:=EvaluateToFloat('sqrt(0.5*exp(x)-0.5*sin(y))');
if GetEvaluationError<>'' then label1.caption:=GetEvaluationError;

Es können auch die Variablen x, y und z verwendet werden
Beispiel:
x:= ... etc.


Popov - Mo 08.12.03 14:29
Auch an dich: wie wäre es mit einem Beispiel, welche Funktion muß man benutzen, welche Mat-Funktionen beherscht deine Unit?

Leute, wenn ihr zu faul seit etwas dazuzuschreiben, dann last das Posten. Was soll man mit Units von denen man nicht weißt wie sie funktionieren. Ein wenig Hilfe-Beschreibung wäre nicht schlecht. Wenn Ihr nicht wißt wie das geht, dann guckt euch die Delphihilfe an.


Sven - Mo 08.12.03 15:03
So umfangreich ist die Klasse nicht, als das man eine Anleitung dafür bräuchte, oder?

Ansonsten probiers mal mit:

Delphi-Quelltext 
1:
2:
3:
 
string := 2.34*(3.45+123)-Trunc(Cos(Rad(45)))/47; 

Ergebnis := EvaluateToFloat(string);


Es besteht übrigens die Möglichkeit die Unit einzubinden und wie oben gezeigt zu verwenden, oder als Komponente, wie man halt eine Komponente verwendet.

Übrigens Popov: Wer lesen kann ist klar im Vorteil, also setzen ... sechs.


Popov - Mo 08.12.03 15:32
Sven hat folgendes geschrieben:
Übrigens Popov: Wer lesen kann ist klar im Vorteil, also setzen ... sechs.


Diesen Spruch kann man loslassen wenn du irgendwo eine Beschreibung gemacht hättest, ich sie aber übersehen hätte. War aber nicht so. Du gehst einfach davon aus, weil du deine Unit gut kennst, daß sie selbsterklärend ist. Woher nimmst du aber die unverfrorenheit anzunehmen, daß jeder der deine Unit benutzen will, sie zuerst studieren muß. Sei doch mal ehrlich; du wolltest dich ein wenig aufspielen und mal dazugehören und hast eine alte Unit ausgerammt und sie einfach gepostet. Sollen sich doch die anderen die Mühe machen und zuerst die Unit durchgucken was sie so alles kann. Die 5 Minuten Arbeit für eine kleine Beschreibung wolltest du dir nicht machen.

Hier muß ich Tino viel Lob für seine Menschenkenntnis zugestehen, weil er mich nicht zum Mod gemacht hat. Ich als Mod hätte dein Beitrag sofort gekillt. Wenn du dir nicht die Arbeit einer Beschreibung machen willst, denn darfst du auch nicht posten. Es geht mir hier nicht darum ob die Unit gut oder schlecht ist, sondern ob man eine Beschreibung mitliefert und eine kleine Hilfe.


Delete - Mo 08.12.03 15:43
Dein Code ist auch übelst zu lesen. persönlich kann jeder den Programmierstil frönen den er will. Aber so bald Code für die Öffentlichkeit bestimmt ist (e.g. OpenSource), sollte man sich zu mindest etwas an geläufuge Konvetionen halten.

Beispiel:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
 
function getvalue(s0:string):extended; 
begin 
if length(s0)<1 then raise EparserError.Create('syntax error'); 
if length(s0)=1 then result:=StrToDbl(s0) else 
  case s0[1] of 
       'x':result:=parameter.x; 
       'y':result:=parameter.y; 
       'z':result:=parameter.z; 
       else result:=StrToDbl(s0); 
       end; 
end;

Ein Chaos von Einrückungen und nicht Einrückungen. Wo fängt hier ein Block an und hört ein anderer auf?

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
 
function getvalue(s0: string): extended;
begin
  if length(s0) < 1 then
    raise EparserError.Create('syntax error');
  if length(s0) = 1 then
    result := StrToDbl(s0)
  else
    case s0[1] of
      'x': result := parameter.x;
      'y': result := parameter.y;
      'z': result := parameter.z;
    else
      result := StrToDbl(s0);
    end;
end;

So sieht das ganze doch schon etwas übersichtlicher aus.

Desweiteren, ein Kommantar an der ein oder andern Stelle wäre nicht zu verachten.

Allgemein zu dieser Sparte
Ich würde es für sinnvoll halten hier einen StyleGuide einzuführen. das dürfte das Arbeiten mit dem Code sehr vereinfachen. Damit da jetzt keine große Diskussion entbrennt, wie was zu formatieren ist, schlage ich vor, dass man sich zumindest grob an den Borland Object Pascal Style Guide hält. Zu finden zum Beispiel hier: http://www.luckie-online.de/artikel/opstyleguide.shtml


Chatfix - Mo 08.12.03 16:45
Ich bin auch dafür das ein bischen übersichtlicher zu halten...
Gibts den StyleGuide auch in Deutsch, da viele Anfänger sicher mit dem Englisch nicht gut zurechtkommen, aber man gerade als Anfänger lernen sollte Übersicht reinzubringen!


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!