Entwickler-Ecke

Open Source Units - Parser für Mathematische Ausdrücke (Terme)


Tyr - So 25.04.04 18:58
Titel: Parser für Mathematische Ausdrücke (Terme)
Ich habe vor einiger Zeit einen kleinen Parser für einfache mathematische Ausdrücke geschrieben. Jetz habe ich ihn erweitert und er funktioniert für mich ganz gut (und auch recht schnell).

Hier der Code:


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:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
 
unit MathParser;

(*******************************************************************************
* Description Free and powerfull recursive parser for mathematical epressions *
* Author      tyr (Martin Raifer)                                             *
* Company     asd                                                             *
* Creation    24.04.2004                                                      *
* Licence     Free (open source)                                              *
* Contact     martinrai2001 at hotmail dot com                                *
* Language    Documentation in german                                         *
*******************************************************************************)

interface

uses Classes;

  //Update 29.04.2004, Udontknow (Andreas Kreul, webmaster at xnebula dot de)
  // - Objektoriente Umsetzung der Unit Mathparser, Umwandlung von Constants
  //   von einem Array in ein Listenobjekt
  // - Korrektur in SwapConstants zwecks Unterstützung längerer Konstantennamen

  type TConstant=class(TObject)
    private
      FName:String;
      FValue:Extended;
    public
      property Name:String read FName write FName;
      property Value:Extended read FValue write FValue;
  end;

  type TConstants=class(TObject)
  private
    FItems:TList;
    function GetItems(Index: Integer): TConstant;
    procedure SetItems(Index: Integer; const Value: TConstant);
    function GetCount:integer;
    function Add:TConstant;
  public
    function IndexOf(name:String):Integer;
    procedure Delete(Index:Integer); overload;
    procedure Delete(Name:String); overload;
    procedure AddConstant(Name:String; Value:Extended);
    procedure Clear;

    property Items[Index:Integer]:TConstant read GetItems write SetItems; default;
    property Count:Integer read GetCount;

    constructor Create; virtual;
    destructor Destroy; override;
  end;

  type TMathParser=class(TObject)
    private
    {Die Funktion Parse bekommt einen String, der einen Mathematischen Term
     enthält. Als Ergebnis liefert Parse den berechneten Wert zurück.
     Im Parse sin Klammern, Strich- und Punktrechnungen, Trigonometrische Fkt-en,
     Hoch, Logaritmus und e Hoch in Kombination mit reellen Zahlen. Der String
     muss mathematisch korrekt sein, sonst wird die Funktion keinen brauchbaren
     Rückgabewert liefern. Außerdem darf der String keine Leerzeichen einthalten.
     Verwenden Sie deshalb die Funktion TrimSpace um evventuelle Leerzeichen zu
     entfernen!

     Funktionsweise:
       Die Funktion teilt den String str so lange nach mathematischen Regeln in
       kleinere Teilstrings auf, bis diese direkt mit mathematischen Funktionen
       oder StrToFloat-Umwandlungen übersetzt werden können.
     Praxisbeispiele:
       2-_xp(3,5)/(e^(7/2)) = 1 Diese Berechnung liefert das Ergebnis 1.000001
                                    und benötigt für die Berechnung 17 Aufrufe des
                                    Parsers
       (2*sin(90)-ln(1024)/ln(2))*(2*((3-(2^2))/2)) = 8 Ergebnis korrekt (= und
                                    benötigt 38 Iterationen.
       Man sieht, dass die Anzahl der Berschnungsschritte ausschließlich von der
       Komplexität der Rechenaufgabe abhängt. doppelte Komplexität ~= doppelte
       Laufzeit.
     }
      function Parse(str : string) : extended;
      {TrimSpace filtert alle Leerzeichen eines Strings heraus und löscht diese im
       Rückgabestring.}
      function TrimSpace(str : string) : string;

      {Über diese beiden Funktionen können Konstanten gemanaged werden. Mit AddConst
       können neue angelegt werden, mit SwapConstants werden alle Vorkommen einer
       Konstante im übergebenen String ersetzt.}
      function SwapConstants(str : string) : string;
    public
      Constants: TConstants;
    {Diese Funktion verwendet Parse, um einen String mathemetisch zu parsen,
     verarbeitet den String (Leerzeichenentfernung) und fängt evventuelle
     Exceptions ab. Auch werden alle vorhalndenen Konstanten eingesetzt. (siehe
     Fkt. SwapConstants) Diese Funktion sollte im Normalfall gegenüber von Parse
     verwendet werden, außer wenn man selbst auf Exeptions reagieren möchte.}

      function ParseStr(Str:String):Extended;

      constructor Create; virtual;
      destructor Destroy; override;
  end;

implementation

uses
  SysUtils, Math;

  function TMathParser.Parse(str : string) : extended;
  var a   : extended; 
      i,j : word;
    {Klammern gibt die Position der passenden abschließenden Klammer zurück} 
    function Klammern(str : string) : word; 
    var i,j : byte; 
    begin 
      Result := 0;
      j:=0; 
      for i:=1 to Length(str) do 
        case str[i] of 
          '(' : Inc(j); 
          ')' : begin 
                  Dec(j); 
                  if j=0 then 
                  begin 
                    Result := i; 
                    Exit; 
                  end; 
                end; 
        end; 
    end; 
  begin 
    {$ifdef Count_Recurses}
      Inc(count); 
    {$endif} 
    //- String '--' verhindern. aus '--' Plus machen 
    str := StringReplace(str, '--', '', [rfReplaceAll]); 
    //-Alle Klammern beseitigen! 
    if Pos('(', str) <> 0 then 
    begin 
      i:=Pos('(', str);
      i:= Klammern(Copy(str, i, high(integer)))+i-1; 
      {Wert in den Klammern berechnen} 
      a:=Parse(Copy(str, Pos('(', str)+1, i-Pos('(', str)-1)); 
      {Weiterparsen...} 
      str := Copy(str, 1, Pos('(', str)-1) + FloatToStr(a) + Copy(str, i+1, High(integer)); 
      Result := Parse(str); 
    end 
    //-Koonstanten 
    //else if processConsts then 
      //Result := const_value 
    //-Trigonometrische Funktionen 
    else if Pos('sin', str) <> 0 then 
    begin 
      i:=Pos('sin', str)+3; 
      while (str[i] in ['0'..'9',',']) or ((i=Pos('sin', str)+3)and(str[i]='-')) do 
        Inc(i); 
      {wie oben} 
      a := sin(2*Pi/360*Parse(Copy(str, Pos('sin', str)+3, i-(Pos('sin', str)+3)))); 
      str := Copy(str, 1, Pos('sin', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); 
      Result := Parse(str); 
    end 
    else if Pos('cos', str) <> 0 then 
    begin 
      i:=Pos('cos', str)+3;
      while (str[i] in ['0'..'9',',']) or ((i=Pos('cos', str)+3)and(str[i]='-')) do 
        Inc(i); 
      a := cos(2*Pi/360*Parse(Copy(str, Pos('cos', str)+3, i-(Pos('cos', str)+3)))); 
      str := Copy(str, 1, Pos('cos', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); 
      Result := Parse(str); 
    end 
    else if Pos('tan', str) <> 0 then 
    begin 
      i:=Pos('tan', str)+3; 
      while (str[i] in ['0'..'9',',']) or ((i=Pos('tan', str)+3)and(str[i]='-')) do 
        Inc(i); 
      a := tan(2*Pi/360*Parse(Copy(str, Pos('tan', str)+3, i-(Pos('tan', str)+3)))); 
      str := Copy(str, 1, Pos('tan', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); 
      Result := Parse(str); 
    end 
    //-andere Funktionen 
    else if Pos('ln', str) <> 0 then 
    begin 
      i:=Pos('ln', str)+2; 
      while (str[i] in ['0'..'9',',']) or ((i=Pos('ln', str)+2)and(str[i]='-')) do 
        Inc(i); 
      a := Ln(Parse(Copy(str, Pos('ln', str)+2, i-(Pos('ln', str)+2)))); 
      str := Copy(str, 1, Pos('ln', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); 
      Result := Parse(str);
    end 
    //Veraltert: Exponentialfunktion e hoch: wegen unkompatibilität zu Konstante 
    //e umbenannt von exp() in _xp(). 
    else if Pos('_xp', str) <> 0 then 
    begin 
      i:=Pos('_xp', str)+3; 
      while (str[i] in ['0'..'9',',']) or ((i=Pos('_xp', str)+3)and(str[i]='-')) do 
        Inc(i); 
      a := Exp(Parse(Copy(str, Pos('_xp', str)+3, i-(Pos('_xp', str)+3)))); 
      str := Copy(str, 1, Pos('_xp', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); 
      Result := Parse(str); 
    end 

    //-Potenzfunktionen 
    else if Pos('^', str) <> 0 then 
    begin 
      i:=Pos('^', str)-1; 
      while str[i] in ['0'..'9',',','-'] do 
        Dec(i); 
      a := Parse(Copy(str, i+1, -i - 1 + Pos('^', str))); 
      j := i; 
      i:=Pos('^', str)+1; 
      while str[i] in ['0'..'9',',','-','^'] do 
        Inc(i);
      a := Power(a,Parse(Copy(str, Pos('^', str) + 1, -Pos('^',str) + i - 1))); 
      Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); 
    end 
    //-Punktrechnungen 
    else if Pos('*', str) <> 0 then 
    begin 
      i:=Pos('*', str)-1; 
      while str[i] in ['0'..'9',','] do 
        Dec(i); 
      a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('*', str))); 
      j:=i; 
      i:=Pos('*', str)+1; 
      while (str[i] in ['0'..'9',',','*','/']) or ((str[i-1]='*')and(str[i]='-')) do 
        Inc(i); 
      a:=Parse(Copy(str, Pos('*', str) + 1, i-Pos('*',str) - 1)) * a; 
      Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); 
    end 
    else if Pos('/', str) <> 0 then 
    begin 
      i:=Pos('/', str)-1; 
      while str[i] in ['0'..'9',','] do 
        Dec(i); 
      a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('/', str))); 
      j:=i;
      i:=Pos('/', str)+1; 
      while str[i] in ['0'..'9',',','/'] do 
        Inc(i); 
      a := a/Parse(Copy(str, Pos('/', str) + 1, -Pos('/',str) + i - 1)); 
      Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); 
    end 
    //-Strichrechnungen 
    else if Pos('+', str) <> 0 then 
    begin 
      i:=Pos('+', str)-1; 
      while str[i] in ['0'..'9',','] do 
        Dec(i); 
      a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('+', str))); 
      j:=i; 
      i:=Pos('+', str)+1; 
      while str[i] in ['0'..'9',','] do 
        Inc(i); 
      a := StrToFloat(Copy(str, Pos('+', str) + 1, -Pos('+',str) + i - 1)) + a; 
      Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); 
    end 
    else if (Pos('-', str) <> 0) and (Pos('-',str) <> 1) then 
    begin 
      i:=Pos('-', str)-1; 
      while str[i] in ['0'..'9',','] do
        Dec(i); 
      //Sonderregelung bei negativen Zahlen: Vorzeichen allein genügt 
      if Copy(str, i+1, -i - 1 + Pos('-', str)) = '' then 
        a:=0 
      else 
        a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('-', str))); 
      j:=i; 
      i:=Pos('-', str)+1; 
      while str[i] in ['0'..'9',','] do 
        Inc(i); 
      a := -StrToFloat(Copy(str, Pos('-', str) + 1, -Pos('-',str) + i - 1)) + a; 
      Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); 
    end 

    //Werte von String in Gleitkomma umwandeln 
    else 
      if str = '' then 
        Result := 0 
      else 
        Result := StrToFloat(str); 
  end; 

  function TMathParser.ParseStr(str : string) : extended;
  begin
    Result := Parse(SwapConstants(TrimSpace(str)));
  end;

  function TMathParser.TrimSpace(str : string) : string;
    function Incr(var i : integer) : integer;
    begin
      Inc(i);
      Result := i;
    end;
  var i,j:integer;
  begin
    j:=0;
    SetLength(Result, Length(str));
    if Length(str)>0 then
      for i:=1 to Length(str) do
        if str[i] <> ' ' then
          Result[Incr(j)] := str[i];
    SetLength(Result, j);
  end;

  function TMathParser.SwapConstants(str : string) : string;
  var i,j:integer;
  var Temp:TConstant;
  begin
    //vorher Konstanten umsortieren, um Fehler bei Konstanten, die einen anderen
    //Konstantennamen in ihrem mit Namen haben, zu vermeiden
    for i:=1 to Constants.Count-1 do
      for j:=0 to i-1 do
        if Pos(Constants[j].Name,Constants[i].Name)>0 then
        begin
          Temp:=Constants[i];
          Constants[i]:=Constants[j];
          Constants[j]:=Temp;
        end;


    Result := str;
    if Constants.Count > 0 then
      for i:=0 to Constants.Count-1 do
        Result := StringReplace(Result, constants[i].name, FloatToStr(constants[i].value), [rfReplaceAll, rfIgnoreCase]);
  end;

{ TConstants }

function TConstants.Add: TConstant;
begin
  Result:=TConstant.Create;
  FItems.Add(Result);
end;

procedure TConstants.AddConstant(Name: String; Value: Extended);
var Con:TConstant;
begin
  if IndexOf(Name)>-1 then
    raise Exception.Create('Konstante bereits vorhanden!');

  Con:=Add;
  Con.Name:=Name;
  Con.Value:=Value;
end;

procedure TConstants.Clear;
var i:integer;
begin
  for i:=Count-1 downto 0 do
    Delete(i);
end;

constructor TConstants.Create;
begin
  FItems:=TList.Create;
end;

procedure TConstants.Delete(Index: Integer);
begin
  TConstant(FItems[Index]).Free;
  FItems.Delete(Index);
end;

procedure TConstants.Delete(Name: String);
begin
  Delete(IndexOf(Name));
end;

destructor TConstants.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TConstants.GetCount: integer;
begin
  Result:=FItems.Count;
end;

function TConstants.GetItems(Index: Integer): TConstant;
begin
  Result:=TConstant(FItems[Index]);
end;

function TConstants.IndexOf(name: String): Integer;
var i:integer;
begin
  Result:=-1;
  for i:=0 to Count-1 do
    if Uppercase(Self[i].Name)=Uppercase(Name) then
    begin
      Result:=i;
      exit;
    end;
end;

procedure TConstants.SetItems(Index: Integer; const Value: TConstant);
begin
  FItems[Index]:=Value;
end;

constructor TMathParser.Create;
begin
  Constants:=TConstants.Create;
  Constants.AddConstant('', 0);
  Constants.AddConstant('pi', PI);
  Constants.AddConstant('e', Exp(1));
end;

destructor TMathParser.Destroy;
begin
  Constants.Free;
  inherited;
end;

end.


Moderiert von user profile iconUdontknow: Code ersetzt durch Überarbeitung


Udontknow - Do 29.04.04 08:39
Hallo. Schöne Unit, einfach zu benutzen! Weiter so.

Ein kleiner Hinweis: Die Methode Parse würde ich persönlich lieber ohne try except-Block realisieren. Wenn ein Fehler bei der Behandlung auftritt, sollte das Programm auch wirklich eine Exception nach oben geben, so kann man ja gar nicht wissen, ob das Ergebnis wirklich 0 ist oder ein Fehler aufgetreten ist.

Dementsprechend besser einfach so :

Delphi-Quelltext 
1:
2:
3:
4:
 
function ParseStr(str : string) : extended; 
begin 
  Result := Parse(SwapConstants(TrimSpace(str))); 
end;


Cu,
Udontknow


Christian S. - Do 29.04.04 08:45
Eventuell könnte man auch eigene Exceptions einbauen.


Udontknow - Do 29.04.04 09:04
Es fehlt auch noch eine Prozedur zum Löschen der Konstanten:


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
 
  procedure DeleteConst(name : string);
  var i:integer;
  begin
    //Index der Konstante suchen
    for i:=0 to Length(constants)-1 do
      if constants[i].Name=Name then
        break;

    //Konstante gefunden?
    if constants[i].Name<>name then
     exit;

    //Aufrücken der Werte
    for i:=i+1 to Length(constants)-1 do
    begin
      constants[i-1].name:=constants[i].name;
      constants[i-1].value:=constants[i].value;
    end;

    //Verkürzen des Arrays
    SetLength(constants,Length(constants)-1);
  end;


Bei vielen Parametern und/oder vielen verschiedenen Funktionsaufrufen mit verschiedenen Konstanten sollte man vielleicht die Unit objektorientiert umsetzen, sodaß man mehrere Parser-Instanzen mit verschiedenen Konstantenlisten erzeugen kann.

Cu,
Udontknow


Udontknow - Do 29.04.04 09:35
Hier mal die OO-Variante:

(In erstem Post eingefügt)

Edit:

Habe noch einen Fehler in der Konstantenbehandlung entdeckt: Wenn man eine Konstante "Test" hat, so ersetzte das Programm das "e" von Test mit dem Wert für e (also erschien dort "T2.27...st") . Ich habe daher in der SwapConstants-Methode eine Vorsortierung implementiert, sodaß Konstanten, die die Namen anderer Konstanten im Namen enthalten, zuerst abgearbeitet werden.

Cu,
Udontknow


Tyr - Do 29.04.04 14:41
Danke für das Interresse und die Verbesserungen...

Ich habe die Konstanten ursprünglich nur für die Zahlen Pi und e verwendet; deshalb habe ich mich nicht allzusehr um die ganze geschichte gekümmert ;) :roll:

Das mit dem try-Block hab ich ganz vergessen wegzulöschen(war nur gedacht für die Testphase). :wink:


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!