Ein Matheparser mit mehreren Typen

deepgreen · Hält's aus hier Beiträge: 12 D7

Dies ist eine recht komplexer Matheparser der nicht der Tradition der anderen Matheparser hier folgt.

Er unterstützt 3 Typen, und zwar Integer, Extended und Boolean.
Es wird ein Binärbaum im Speicher aufgebaut der in etwa solch eine Struktur besitzt:

'1+3-3' wird zum Beispiel aufgebaut in ->

markieren

Quelltext

1:
2:
3:
4:
5:

und dann von links nach rechts durchgearbeitet

Der ganze Krempel wie Prioritäten von Operatoren (Punkt vor Strichrechnung), Klammern und soweiter sind selbstverständlich eingebaut.
Es gibt viele Operatoren, darunter auch binäre sowie Vergleichsoperatoren

Eigentlich ist mein Parser stark an die Delphibehandlung von Ausdrücken angelegt, samt Prioritäten von Operatoren.
Die ganzen Operatoren (mit Ergebnistyp)

markieren

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:

Op_Negate         ->            ! (Boolean) -> (Boolean)
Op_Or             -> (Boolean)  | (Boolean) -> (Boolean)
Op_Xor            -> (Boolean)  ^ (Boolean) -> (Boolean)
Op_And            -> (Boolean)  & (Boolean) -> (Boolean)

Op_Equal          -> (Integer)  = (Integer) -> (Boolean)
                        (Real)  = (Integer) -> (Boolean)
                     (Integer)  = (Real)    -> (Boolean)
                        (Real)  = (Real)    -> (Boolean)
Op_NotEqual       -> (Integer) <> (Integer) -> (Boolean)
                        (Real) <> (Integer) -> (Boolean)
                     (Integer) <> (Real)    -> (Boolean)
                        (Real) <> (Real)    -> (Boolean)
Op_Less           -> (Integer)  < (Integer) -> (Boolean)
                        (Real)  < (Integer) -> (Boolean)
                     (Integer)  < (Real)    -> (Boolean)
                        (Real)  < (Real)    -> (Boolean)
Op_Greater        -> (Integer)  > (Integer) -> (Boolean)
                        (Real)  > (Integer) -> (Boolean)
                     (Integer)  > (Real)    -> (Boolean)
                        (Real)  > (Real)    -> (Boolean)
Op_EqualOrLess    -> (Integer) <= (Integer) -> (Boolean)
                        (Real) <= (Integer) -> (Boolean)
                     (Integer) <= (Real)    -> (Boolean)
                        (Real) <= (Real)    -> (Boolean)
Op_EqualOrGreater -> (Integer) >= (Integer) -> (Boolean)
                        (Real) >= (Integer) -> (Boolean)
                     (Integer) >= (Real)    -> (Boolean)
                        (Real) >= (Real)    -> (Boolean)

Op_Multiplication -> (Integer)  * (Integer) -> (Integer)
                        (Real)  * (Integer) -> (Real)
                     (Integer)  * (Real)    -> (Real)
                        (Real)  * (Real)    -> (Real)
Op_Addition       -> (Integer)  + (Integer) -> (Integer)
                        (Real)  + (Integer) -> (Real)
                     (Integer)  + (Real)    -> (Real)
                        (Real)  + (Real)    -> (Real)
Op_Subtraction    -> (Integer)  - (Integer) -> (Integer)
                        (Real)  - (Integer) -> (Real)
                     (Integer)  - (Real)    -> (Real)
                        (Real)  - (Real)    -> (Real)
Op_RDivision      -> (Integer)  / (Integer) -> (Real)
                        (Real)  / (Integer) -> (Real)
                     (Integer)  / (Real)    -> (Real)
                        (Real)  / (Real)    -> (Real)

Op_IDivision      -> (Integer) */ (Integer) -> (Integer)
Op_Modulo         -> (Integer)  % (Integer) -> (Integer)
Op_ShiftLeft      -> (Integer) << (Integer) -> (Integer)
Op_ShiftRight     -> (Integer) >> (Integer) -> (Integer)
Op_Negate         -> (Integer)  ~ (Integer) -> (Integer)
Op_Or             -> (Integer)  | (Integer) -> (Integer)
Op_Xor            -> (Integer)  ^ (Integer) -> (Integer)
Op_And            -> (Integer)  & (Integer) -> (Integer)
Op_Negate         ->            ! (Integer) -> (Integer)

Zurzeit erfolgt keine Kontrolle auf korrekte Syntax, also kann man auch nen Boolean mitm Integer kombinieren (eigentlich Müll) und es wird auch berechnet, korrekte Klammerverwendung wird auch nicht geprüft.
Also einfach zur Sicherheit eine sicher korrekte Syntax verwenden.
Beispiele für nicht so simple Terme:

markieren

Quelltext

1:
2:
3:

(((7*3)+2*5)<<2)&17       (Result ist vom Typ Integer)  -> 16
13/(21*12)+3*7,3+2/7      (Result ist vom Typ Extended) -> 22,237
true&((17*3)>(34423>>10)) (Result ist vom Typ Boolean)  -> True

Funktionen wie sin oder cos sind zur Zeit noch nicht eingebaut worden, ist aber prinzipiell für den eigentlichen Parser später vorgesehen.

Es gibt 3 Arten von Funktionen
Die Baufunktion, die Berechnungsfunktionen und die Vernichtenfunktion
Es fehlt nur noch eine vorgeschaltete Funktion zur Prüfung des Ausdrucks
(Hat einer Bock das zu machen, würd mich freuen ?

)

Die Baufunktion nimmt den gesamten String und baut daraus einen Baum
Die Berechnungsfunktionen sind unterteilt in die Typen die erwartet werden, kann man feststellen indem man die Tochterknoten nach dem Ergebnistyp abfragt und dementsprechend die richtige Berechnungsfunktion aufruft.
Die Vernichtenfunktion entfernt das komplette Baumgebilde aus dem Speicher.

Der Vorteil des Baums ist das er erhalten bleiben kann nach der Berechnung und extrem schnelle Berechnung ermöglicht.
Die meiste Rechenarbeit geht für das aufbauen drauf, die spätere Berechnung ist jedoch blitzschnell.

ein Beispielaufruf wäre:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TForm1.Button1Click(Sender: TObject);
var mathparser: TMath;
begin
  mathparser := TMath.Create(edit1.text);
  case mathparser.Content of
    T_Integer: ShowMessage('Integer: ' + IntToStr(mathparser.ResultInt));
    T_Extended: ShowMessage('Extended: ' + FloatToStr(mathparser.ResultExt));
    T_Boolean: ShowMessage('Boolean: ' + BoolToStr(mathparser.ResultBool, true));
  end;
  mathparser.destroy;
end;

(halt irgendeinem Button zuweisen, und ein edit dazu)

Und nun die gesamte Unit:

markieren

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:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:

//copyright by Karsten König
//you can change and distribute this unit as you want to, but give credit to me ;)
unit uMathParser;

interface

uses strutils, sysutils;

type
  //Die Operatoren
  EOp = (Op_None, Op_Equal, Op_NotEqual, Op_Less, Op_Greater, Op_Modulo,
                Op_EqualOrLess, Op_EqualOrGreater, Op_Addition, Op_Subtraction,
                Op_Multiplication, Op_IDivision, Op_Or, Op_Xor, Op_And,
                Op_ShiftLeft, Op_ShiftRight, Op_Negate, Op_RDivision);

  //Die Variablentypen
  EType = (T_Op, T_Boolean, T_Integer, T_Extended);

  TExpNode = class
  private
    fContent: EType;
  public
    property Content: EType read fContent;
    destructor Destroy; virtual; abstract;
    function ResultInt: Integer; virtual; abstract;
    function ResultExt: Extended; virtual; abstract;
    function ResultBool: Boolean; virtual; abstract;
  end;

  TOpNode = class(TExpNode)
  private
    fl, fr: TExpNode;
    fOp: EOp;
  public
    constructor Create(s: string; posi, len: Integer; Op: EOp);
    destructor Destroy; override;
    function ResultInt: Integer; override;
    function ResultExt: Extended; override;
    function ResultBool: Boolean; override;
  end;

  TConstNode = class(TExpNode)
  private
    fData: Pointer;
  public
    constructor Create(s: string);
    destructor Destroy; override;
    function ResultInt: Integer; override;
    function ResultExt: Extended; override;
    function ResultBool: Boolean; override;
  end;

  TMath = class(TExpNode)
  private
    fStart: TExpNode;
  public
    constructor Create(s: string);
    destructor destroy; override;
    function ResultInt: Integer; override;
    function ResultExt: Extended; override;
    function ResultBool: Boolean; override;
  end;

  function GetType(s:string):EType;
  function GetOp(var s:string; var posi, len: integer):EOp;

implementation

//Funktion die Teilstrings zurückgibt (entfernt auch Leerzeichen)
function GetSubStr(s: string; StartPos, EndPos: Integer):string;
begin
  result := Copy(s, Startpos, Endpos + 1 - Startpos);
  trim(result);
end;

//Prüft obs eine Ziffer (Ohne 0) ist
function Is_NumberNo0(s: char):boolean;
begin
  result := (Byte(s) >= 49) and (Byte(s) <= 57);
end;

//Prüft obs eine Ziffer (inkl. 0) ist
function Is_Number(s: char):boolean;
begin
  result := Is_NumberNo0(s) or (s = '0');
end;

//Prüft obs eine ganze Zahl ohne führende 0 ist (Integer)
function Is_Integer(s: string):boolean;
var i:byte;
begin
  if (s[1] = '-') or (s[1] = '+')
    then delete(s, 1, 1);
  if length(s) > 1 then
  begin
    if Is_NumberNo0(s[1]) then
    begin
      i := 2;
      while (i <> length(s)) and Is_Number(s[i])
      do inc(i);
      result := Is_Number(s[i]);
    end
    else
      result := false;
  end
  else
    result := Is_Number(s[1]);
end;

//Prüft obs eine ganze Zahl mit führender 0 ist (für reele Zahlen)
function Is_IntegerWL0(s: string):boolean;
var i:byte;
begin
  if length(s) > 1 then
  begin
    i := 1;
    while (i <> length(s)) and Is_Number(s[i])
    do inc(i);
    result := Is_Number(s[i]);
  end
  else
    result := Is_Number(s[1]);
end;

//Prüft obs eine reele Zahl (Extended) ist
//Aufbau (Integer) + ',' + (IntegerWL0)
function Is_Real(s: string):boolean;
var i: integer;
begin
  i := PosEx(',', s, 1);
  if i > 0 then
  begin
    if PosEx(',', s, i + 1) > 0
    then result := false
    else
      result := Is_Integer(GetSubStr(s, 1, i - 1)) and Is_IntegerWL0(GetSubStr(s, i + 1, length(s)))
  end
  else result := Is_Integer(s);
end;

//Prüft obs ein Boolean ist (Boolean)
function Is_Boolean(s: string):boolean;
begin
  result := (s = 'true') or (s = 'false');
end;

//Lokalisiert einen Operator (Suchrichtung ist von rechts nach links)
//zurückgegeben werden die Position und Länge des Operators und dessen Art
//Klammern etc werden hier auch behandelt
function GetOp(var s:string; var posi, len: integer):EOp;
var Priority: integer;
    bracketcount: integer;
begin
  result := Op_None;
  bracketcount := 0; //Wird genutzt zum behandeln von Klammern
  //Sollte eine Klammer auftreten, wird solange jegliches Zeichen ignoriert bis alle
  //Klammern geschlossen sind

  Priority := 0; //Verschiedene Operatoren sind alle unterschiedlich wichtig
  //Bsp. Punktrechnung vor Strichrechnung, dem wird hiermit Rechnung getragen
  repeat
    posi := length(s) + 1;
    repeat
      dec(posi);
      if s[posi] = ')' then inc(bracketcount);
      if s[posi] = '(' then dec(bracketcount);
      if bracketcount = 0 then //sollte keine Klammer offen sein wird das aktuelle
                              //Zeichen auf einen Operator untersucht
        case Priority of
          0:
            if s[posi] = '|' then result := Op_Or;
          1:
            if s[posi] = '^' then result := Op_XOr;
          2:
            if s[posi] = '&' then result := Op_And;
          3:
            begin
              if s[posi] = '=' then result := Op_Equal;
              if s[posi-1] + s[posi] = '<>' then result := Op_NotEqual;
            end;
          4:
            begin
              if (s[posi - 1] <> '<') and (s[posi] = '<') and (s[posi + 1] <> '<')
                then result := Op_Less;
              if (s[posi - 1] <> '>') and (s[posi] = '>') and (s[posi + 1] <> '>')
                then result := Op_Greater;
              if s[posi-1] + s[posi] = '<=' then result := Op_EqualOrLess;
              if s[posi-1] + s[posi] = '>=' then result := Op_EqualOrGreater;
            end;
          5:
            begin
              if s[posi-1] + s[posi] = '<<' then result := Op_ShiftLeft;
              if s[posi-1] + s[posi] = '>>' then result := Op_ShiftRight;
            end;
          6:
            begin
              if (s[posi] = '+') and (posi > 1) then result := Op_Addition;
              if (s[posi] = '-') and (posi > 1) then result := Op_Subtraction;
            end;
          7:
            begin
              if s[posi] = '*' then result := Op_Multiplication;
              if s[posi] = '/' then result := Op_RDivision;
              if s[posi - 1] + s[posi] = '*/' then result := Op_IDivision;
              if s[posi] = '%' then result := Op_Modulo;
            end;
          8:
            begin
              if s[posi] = '!' then result := Op_Negate;
            end;
        end;
    until (result <> Op_None) or (posi = 1); //Solange den Text von hinten nach vorn
                    // durchgehen bis ein Operator gefunden ist, bzw. man ganz vorn ist

    if (result = Op_None) and (Priority  < 9)
      then inc(Priority); //sollte kein Operator gefunden sein, nach Operatoren mit
          //höherer Priorität suchen

    //Für den Fall das kein Operator gefunden wurde überprüfen ob der Term von Klammern
    //umschlossen ist, in diesem Falle entfernen und erneut beginnen
    if (Priority = 9) and (s[1] = '(') and (s[length(s)] = ')') then
    begin
      Priority := 0;
      delete(s, 1, 1);
      delete(s, length(s), 1);
    end;
  until (result <> Op_None) or (Priority = 9);

  if (result <> Op_None) then //Hier muss nun die Länge des Operators ermittelt werden
  begin
    case result of
      Op_ShiftLeft, Op_ShiftRight, Op_EqualOrLess, Op_EqualOrGreater,
        Op_NotEqual, Op_IDivision: len := 2;
      Op_Or, Op_XOr, Op_And, Op_Less, Op_Greater, Op_Addition, Op_Equal,
        Op_Subtraction, Op_Multiplication, Op_RDivision, Op_Negate,
        Op_Modulo: len := 1;
    end;
  end;
end;

//Gibt den Typ einer Konstanten zurück (Integer/Extended/Boolean)
function GetType(s:string):EType;
begin
  if Is_Integer(s)
    then result := T_Integer
    else
    begin
      if Is_Real(s) then result := T_Extended;
      if Is_Boolean(s) then result := T_Boolean;
    end;
end;

constructor TConstNode.Create(s: string);
begin
  self.fContent := GetType(s);
  case self.fContent of
  T_Integer:
    begin
      New(PInteger(self.fData));
      PInteger(self.fData)^ := StrToInt(s);
    end;
  T_Extended:
    begin
      New(PExtended(self.fData));
      PExtended(self.fData)^ := StrToFloat(s);
    end;
  T_Boolean:
    begin
      New(PBoolean(self.fData));
      PBoolean(self.fData)^ := StrToBool(s);
    end;
  end;
end;

constructor TOpNode.Create(s: string; posi, len: Integer; Op: EOp);
var newposi, newlen: integer;
    newOp: EOp;
    tempstring: string;
begin
  fOp := Op; //Operator speichern
  if fOp = Op_Negate then
  begin
    tempstring := GetSubStr(s, 1 + len, length(s));
    newOp := GetOp(tempstring, newposi, newlen); //Ermittlung des Knotentyps (Operator / Konstante)
    if newOp = Op_None
      then fr := TConstNode.Create(s)
      else fr := TOpNode.Create(s, newposi, newlen, newOp);
    //Negation wird nur der rechten Seite zugewiesen
    fContent := fr.content; //Der eigene Ergebnistyp
      //Entspricht dem Ergebnistyp des rechten Zweiges
  end
  else
  begin
    //die Zweige Links und rechts des Operators erstellen
    tempstring := GetSubStr(s, 1, posi - len);
    newOp := GetOp(tempstring, newposi, newlen); //Ermittlung des Knotentyps (Operator / Konstante)
    if newOp = Op_None
      then fl := TConstNode.Create(tempstring)
      else fl := TOpNode.Create(tempstring, newposi, newlen, newOp);
    tempstring := GetSubStr(s, posi + 1, length(s));
    newOp := GetOp(tempstring, newposi, newlen); //Ermittlung des Knotentyps (Operator / Konstante)
    if newOp = Op_None
      then fr := TConstNode.Create(tempstring)
      else fr := TOpNode.Create(tempstring, newposi, newlen, newOp);
    case fOp of //Hier werden der Ergebnistyp zugewiesen (siehe Schema oben)
      Op_ShiftLeft, Op_ShiftRight, Op_Modulo, Op_IDivision,
        Op_Negate: fContent := T_Integer;
      Op_RDivision: fContent := T_Extended;
      Op_Equal, Op_NotEqual, Op_Less, Op_Greater, Op_EqualOrLess,
        Op_EqualOrGreater: fContent := T_Boolean;
      Op_Multiplication, Op_Addition, Op_Subtraction:
          if (fl.Content = T_Extended)
              or (fr.Content = T_Extended)
                then fContent := T_Extended
                else fContent := T_Integer;
      Op_And, Op_Or, Op_XOr:
          if (fl.content = T_Boolean)
              or (fr.content = T_Boolean)
                then fContent := T_Boolean
                else fContent := T_Integer;
    end;
  end;
end;

constructor TMath.Create(s: string);
var posi, len: integer;
    Op: EOp;
begin
  Op := GetOp(s, posi, len); //Ermittlung des Knotentyps (Operator / Konstante)
  if Op = Op_None
  then fStart := TConstNode.Create(s)
  else fStart := TOpNode.Create(s, posi, len, Op);
  fContent := fStart.Content;
end;

function TConstNode.ResultInt: Integer;
begin
  result := PInteger(fData)^;
end;

function TOpNode.ResultInt: Integer;
begin
  case fOp of
    Op_Addition:
      result := fl.ResultInt + fr.ResultInt;
    Op_Subtraction:
      result := fl.ResultInt - fr.ResultInt;
    Op_Multiplication:
      result := fl.ResultInt * fr.ResultInt;
    Op_IDivision:
      result := fl.ResultInt div fr.ResultInt;
    Op_Modulo:
      result := fl.ResultInt mod fr.ResultInt;
    Op_XOr:
      result := fl.ResultInt xor fr.ResultInt;
    Op_And:
      result := fl.ResultInt and fr.ResultInt;
    Op_Or:
      result := fl.ResultInt or fr.ResultInt;
    Op_Negate:
      result := Not fr.ResultInt;
    Op_ShiftLeft:
      result := fl.ResultInt shl fr.ResultInt;
    Op_ShiftRight:
      result := fl.ResultInt shr fr.ResultInt;
  end;
end;

function TMath.ResultInt: Integer;
begin
  result := fStart.ResultInt;
end;

function TConstNode.ResultExt: Extended;
begin
  result := PExtended(fdata)^;
end;

function TOpNode.ResultExt: Extended;
begin
  case fOp of
    Op_Addition:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt + fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt + fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt + fr.ResultExt;
    end;
    Op_Subtraction:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt - fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt - fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt - fr.ResultExt;
    end;
    Op_Multiplication:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt * fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt * fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt * fr.ResultExt;
    end;
    Op_RDivision:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt / fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt / fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt / fr.ResultExt;
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt / fr.ResultInt;
    end;
  end;
end;

function TMath.ResultExt: Extended;
begin
  result := fStart.ResultExt;
end;

function TConstNode.ResultBool: Boolean;
begin
  result := PBoolean(fdata)^;
end;

function TOpNode.ResultBool: Boolean;
begin
  case fOp of
    Op_Equal:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt = fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt = fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt = fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt = fr.ResultExt;
    end;
    Op_NotEqual:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt <> fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt <> fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt <> fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt <> fr.ResultExt;
    end;
    Op_Less:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt < fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt < fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt < fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt < fr.ResultExt;
    end;
    Op_Greater:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt > fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt > fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt > fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt > fr.ResultExt;
    end;
    Op_EqualOrLess:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt <= fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt <= fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt <= fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt <= fr.ResultExt;
    end;
    Op_EqualOrGreater:
    begin
      if (fl.Content = T_Integer) and (fr.Content = T_Integer)
        then result := fl.ResultInt >= fr.ResultInt;
      if (fl.Content = T_Extended) and (fr.Content = T_Integer)
        then result := fl.ResultExt >= fr.ResultInt;
      if (fl.Content = T_Integer) and (fr.Content = T_Extended)
        then result := fl.ResultInt >= fr.ResultExt;
      if (fl.Content = T_Extended) and (fr.Content = T_Extended)
        then result := fl.ResultExt >= fr.ResultExt;
    end;
    Op_Or:
      result := fl.ResultBool or fr.ResultBool;
    Op_And:
      result := fl.ResultBool and fr.ResultBool;
    Op_Xor:
      result := fl.ResultBool xor fr.ResultBool;
    Op_Negate:
      result := not fr.ResultBool;
  end;
end;

function TMath.ResultBool: Boolean;
begin
  result := fStart.ResultBool;
end;

//Entfernt einen Knoten mitsamt allen Unterknoten
destructor TConstNode.Destroy;
begin
  case fContent of
  T_Integer:
      Dispose(PInteger(fData));
  T_Extended:
      Dispose(PExtended(fData));
  T_Boolean:
      Dispose(PBoolean(fData));
  end;
  inherited;
end;

destructor TOpNode.Destroy;
begin
  fr.Destroy;
  if not (fOp = Op_Negate)
    then fl.Destroy;
  inherited;
end;

destructor TMath.Destroy;
begin
  fStart.Destroy;
  inherited;
end;

end.

Ich würde mich über Feedback freuen

Am wichtigsten wäre mir vorallem konstruktive Kritik sowie Vorschläge zur Optimierung der Geschwindigkeit !
Und mathematische Ausdrücke die von der Syntax her korrekt sind, aber einen Fehler produzieren sind auch von Interesse.

sourcehunter · Beiträge: 482 Win XP | Suse 10.1 Delphi 2005 Pers.

Klingt ganz vernünftig, aber warum benutzt du keine Klassen, wo du doch Delphi nimmst? Das mit den verschiedenen Typen is ne tolle Idee, vielleicht nehme ich das auch in meinen Parser, wenn du das erlaubst. :wink:

Im prinzip binn ich genauso vorgegangen, wie du. Ich habe übrigens eine einfache Sytaxprüfung, falls du dir die ansehen möchtest, aber wie gesagt sie ist einfach.

_________________
Linux und OpenSource rulez!

deepgreen · Hält's aus hier Beiträge: 12 D7

Ich benutz im Rest des Parsers für alles Klassen (damit man einfach seine eigenen Befehle schreiben kann), ich dachte eigentlich, dass die Verwendung einer Klasse einfach mal zuviel Rechenzeit vernichtet für eine Sache die möglichst schnell ablaufen soll.
Hab das eigentlich deshalb so gemacht weil wir für unser Informatik Projekt einen Scriptinterpreter schreiben sollten der seinen Schwerpunkt bei mathematischen Ausdrücken hat.
Oder meinst du die ganze Unit in einer Klasse kapseln ? (aka TMath)

Hatte es nämlich so verstanden das du für die einzelnen Baumknoten Objekte verwenden wolltest.
Könnte man sicher schnell dahingehend umschreiben, aber ich bin ein Fan von Case anweisungen und typisierten Zeigern

Klar kannst das in deinen Parser einbauen, dafür hab ichs hier ja veröffentlicht

Würd mich freuen wenn ich mir mal deine Syntaxprüfung angucken könnte, ich hatte damals noch eine für einen reinen DoubleWerte-Matheparser geschrieben, aber die war auch nicht so der Kracher, deswegen freu ich mich über alle Ansätze.
Ich hab bei der Überprüfung von Strings auf korrekte Eingabe sowieso nen Hals, weil ich mit strings immer leicht irgendwelche Fehler einbaue, was mir selbst bei elends langen Pointerkonstrukten kaum passiert.

[EDIT]
Ok habs mir nochn bissl länger durchn Kopf gehen lassen, ich versuchs mal so weit wie möglich alles in schnuckelige Klassen zu packen und dann mit Objekten ablaufen zu lassen und gucke mal in wie fern eine Geschwindigkeitseinbuße auftritt

sourcehunter · Beiträge: 482 Win XP | Suse 10.1 Delphi 2005 Pers.

Ich wollte dich ja nicht zu Klassen zwingen, denn es funktioniert ja auch so. Jeder so, wie er es mag, aber toll, dass du einen Vergleich machst.
Meine Syntaxprüfung beschränkt sich auf korrekte Anzahl von Klammern und dass keine 2 Operatoren nebeneinander stehen, also denke ich, dass du mit deiner alten Syntaxprüfung ein ganzes Stück weiter bist.

_________________
Linux und OpenSource rulez!

deepgreen · Hält's aus hier Beiträge: 12 D7

So, ich hab es jetzt mit den Klassen durchprobiert, läuft super und auch im gleichen (teilweise sogar schnellerem) Tempo, also danke für den Ansatz

Deswegen habe ich den Quelltext oben mit der Objektorientrierten Methode ersetzt, vorallem weil sie mir auch übersichtlicher erscheint (diese Pointer auf Pointer etc fallen weg)
Als nächstes hau ich dann noch ne gute Syntaxprüfung rein

Was mir missfällt ist die recht umständliche Behandlung von den unterschiedlichen Typen (dauernd Überprüfung mit den Typen)
Wer mir helfen will/kann:
www.delphi-forum.de/...+Property_34292.html

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme