ein selbst programmierter mathematischer Parser: Die Homepage von Joachim Mohr

Die Homepage von Joachim Mohr

≡

Umwandlung Dezimal- in Dualzahlen

Backtracking

Lektion 16
ein selbst programmierter mathematischer Parser
(c) Joachim Mohr
Theorie mit Kopiervorlage

Kopiervorlage des Parsers (Kann in jedes Delphiprojekt kopiert werden.)

Lektion 16

Ein mathematischen Parser ist eine Funktion, der ein arithmetischer Ausdruck (Term) als String übergeben werden kann. Das Resultat der Funktion ist dann der Wert des Terms.

Zum Beispiel kann man einer solchen Funktion als Eingangsvariable den String (2+3*(8-27/2)) übergeben. Die Funktion liefert dann als Ergebnis die reelle Zahl -14,5. Der Term kann auch Variablen z.B. x enthalten. Dann kann z.B. zur Berechnung einer Wertetafel dem mathematischen Parser den String 1/3*x^3-3*x+sin(x) übergeben.

Im Programm ist erkennbar, welche Funktionen implementiert sind.
Eine Prüfung auf syntaktische Korrektheit des Terms wäre wünschenswert, ist hier aber nur im Ansatz implementiert.

Die Übernahme des Parsers in andere Programme ist leicht: Kopieren Sie die farbige Kopiervorlage der Funktion TermtoReal mitsamt den Hilfsfunktionen in ihr Programm.

Theorie

"Iterativ arbeiten ist menschlich, rekursiv arbeiten ist göttlich"
Anonym

Rekursionen sind erstaunlich kurze, leicht verständliche und effiziente Algorithmen.

Ein großes Problem wird solange in Teilprobleme zerlegt, die ähnlich strukturiert sind, bis das Problem einfach gelöst werden kann.

   Hier z.B.: Der Sting '2*8+5*9' wird zerlegt in
                        '2*8' und '5*9' und dann in
                        '2', '8', '5' und '9' als Strings.
               Mit StrToFloat werden diese in Zahlen umgeformt,
               dann wird rückwärts zweimal multipliziert
               und einmal addiert.

Das Grundprinzip dieses rekursiven Parser ist die folgende Funktion TermToReal(s) mit Hilfsfunktionen

Anfang Grundprinzip

function anfang(s:string;c:char):string;
begin
  anfang:=copy(s,1,pos(c,s)-1);
end;

function copyab(const s:string; const i:integer):string;
  begin result:=copy(s,i,length(s)-i+1) end;

function ende(s:string; c:char):string;
begin
  ende:=copyab(s,pos(c,s)+1)
end;

function TermToReal(s:string):real;
//  {Bisher nur '*' und '+' integriert}
begin
  if pos('+',s)>0  then
    result:=TermToReal(anfang(s,'+'))+TermToReal(ende(s,'+')) else
  if pos('*',s)>0 then
    result:=TermToReal(anfang(s,'*'))*TermToReal(ende(s,'*')) else
  result:=StrToFloat(s);
end;

Ende Grundprinzip

Wichtig:Zunächst wird die Addition berücksichtigt, dann erst die Multiplikation ("Punkt- vor Strichrechnung"). Im Grundprinzip also:

TermToReal('a*b+c*d')=TermToReal('a*b')+TermToReal('c*d').

Weitere Operationen wie "-", "/" und "^" sind dann einfach wie auch eine Variable x zu integrieren. (Mit der Variablen x sind dann auch Schaubilder und Wertetafeln erstellbar).

Aber bei Klammern darf ich z.B. "+" in 2*(3+5) nicht zuerst berücksichtigen.
pos('+',s) muss abgeändert werden in pos0('+',s), wobei gilt:
pos0('+',s) ist nur dann >0 wenn "+" außerhalb einer Klammer ist. Damit ist gewährleistet, dass Klammern als erstes ausgewertet werden (Alle anderen Operationen werden zunächst "zurückgestellt".). Z.B. ist dann

TermToReal('2*(3+5)')=TermtoReal('2')*TermToReal('(3+5)')

Bei der folgenden Funktion "TermToReal" mit seinen Hilfsfunktionen ist dies gelöst.

Ein mathematischer Parser für gebrochen rationale Funktionen

Bei diesem Parser wird gezeigt, wie eine Wertetafel für eine gebrochen rationale
Funktion ausgegeben werden kann:

Aufruf termtoReal(term,x)

Parser ab hier kopieren und in das eigene Programm einfügen


Procedure Fehlerbehandlung(const s: string);
begin
   //Je nachdem showmessege(s) oder bei Schaubild ignorieren
   showmessage(s);
end;

function IsInteger(const x: extended; eps_Genauigkeit: extended): boolean;
begin
  result := frac(abs(x) + eps_Genauigkeit) « eps_Genauigkeit * 2;
end;

function HochInt(X: Extended; n: Integer): Extended;
begin
  if n « 0 then result := 1.0 / HochInt(x, -n) else Begin //Iterativ
    Result := 1.0;
    while n » 0 do BEgin
      while not Odd(n) do
      BEGin
        n := n shr 1;
        X := X * X
      END;
      Dec(n);
      Result := Result * X
    ENd;
  End;
end;

function HochReal(x, y: Extended): Extended;
begin
  result := 0;
  try
    if y = 0.0 then Result := 1.0 {x^0=1 0^x=0}
    else if (x = 0.0) and (y » 0) then Result := 0.0
    else if IsInteger(y, 1E-18) and (Abs(y) «= MaxInt) then
      Result := HochInt(x, Integer(Round(y)))
    else if x«=0 then Fehlerbehandlung('Potenzieren')
      else Result := Exp(y * Ln(x))
  except Fehlerbehandlung('Potenzieren') end;
end;


function TermToReal(s:string; x:extended): extended; //Darüber: die mathematischen Hilfsfunktionen
   var xglobal: extended; //weitere Parameter denkbar
 function TTR(s:string): extended; //TTR = "Termtoreal ohne x"
  //  {Bisher '+', '-', '*', '/', '^', Klammern und 'x' integriert,
  //   d.h. gebrochen rationale Funktionen werden ausgewertet
     //——— Hilfsfunktionen ————————————————————
   function pos0(c:char;s:string):integer;
     //pos0 findet das Zeichen "+","-" ... nicht innerhalb von Klammern
      var k,z:integer; //z:=Anzahl der Klammern
   begin
     z:=0;
     for k:=length(s) downto 1 do Begin //Korrigiert Dez. 2002
       if s[k]='(' then inc(z);
       if s[k]=')' then dec(z);
       if (z=0) and (s[k]=c) then BEgin
        result:=k; //Treffer
        exit;
      ENd;
    End;
    result:=0; //nichts gefunden
  end;

   function anfang(s:string;c:char):string;
   begin
     anfang:=copy(s,1,pos0(c,s)-1);
   end;

   function copyab(const s:string; const i:integer):string;
     begin result:=copy(s,i,length(s)-i+1) end;

   function ende(s:string; c:char):string;
   begin
     ende:=copyab(s,pos0(c,s)+1)
   end;
 begin
  //showmessage(s); Empfehlenswert zum Verständnis
  if pos0('+',s)»0  then result:=TTR(anfang(s,'+'))+TTR(ende(s,'+')) else
  if pos0('-',s)»0  then result:=TTR(anfang(s,'-'))-TTR(ende(s,'-')) else
  if pos0('*',s)»0 then  result:=TTR(anfang(s,'*'))*TTR(ende(s,'*')) else
  if pos0('/',s)»0 then  result:=TTR(anfang(s,'/'))/TTR(ende(s,'/')) else
  if pos0('^',s)»0 then  result:=hochreal(TTR(anfang(s,'^')),TTR(ende(s,'^'))) else
  if (s»'') and (s[1]='(') then Begin //Am Anfang und Ende eine Klammer
    s:=copy(s,2,length(s)-2);
    result:=TTR(s)
  End else
  if s='x' then result:=xGlobal else
    result:=StrToFloat(s);
 end;
begin //
  xGlobal := x;
  result := TTR(s);
end;

Ende des Parsers (fürs Kopieren)
Beispiel zur Anwendung

procedure TForm1.Button1Click(Sender: TObject);
     var x,y: extended;
       term: string;
begin
   term := '1/3*x^3 - 3*x'; // Hier noch "*" erfordelich. Beim nächsten Beispiel nicht mehr!
   //oder term := edit1.text;
   memo1.text := 'x      f(x)';
   memo1.Font.Name := 'Courier New';
   x := -5;
   repeat
     y := termToReal(term,x);
     memo1.lines.Add(formatfloat(' 0.0   ;-0.0   ', x) + formatfloat('0.###',y));
     x := x + 1/2;
   until x » 5; //Fehler: "until x = 5.5", da extended nicht exakt
end;

Ein mathematischer Parser mit vielen weiteren Funktionen:

Wie man noch alle möglichen Funnktionen integrieren kann, ja sogar auf das "*"-Zeichen wie üblich verzichten kann, wird am folgenem Parser demonstriert. Weitere Funktionen zu integrieren, dürfte kein Problem sein:

Zuerst in Pascal formulieren.

function myfunktion(x: extended): extended;
begin
  //
end;   

Dann an passender Stelle folgende Zeile einfügen

    if u6='myfunk' then result:=myfunktion(TTR(v6)) else

Fertig !

Aufruf termtoReal(term,x)

einfach kopieren und in das eigene Programm übertragen


(* (c) Joachim Mohr, Rottenburg am Neckar
   Die Unit darf frei in nichtkommerziellen Programmen verwendet
   werden, wenn der CopyRight-Vermerk nicht entfernt wird.
   Kritik, Anregungen, Verbesserungsvorschläge bitte an
   http://kilchb.de *)

Procedure Fehlerbehandlung(const s: string);
begin
   //Je nachdem
   showmessage('Fehler bei '+s); //oder zum Beispiel bei Schaubild ignorieren oder
   //raise EMathError.Create('Fehler bei ' + s); //Fehlermedlung des Sysstems
end;

function ln0(x:extended):extended;
begin
   if x«1E-15 then Begin
     result := 0;
     Fehlerbehandlung('Logarithmus von '+FloatToStr(x));
   End else result := ln(x)
end;


function IsInteger(const x: extended; eps_Genauigkeit: extended): boolean;
begin
  result := frac(abs(x) + eps_Genauigkeit) « eps_Genauigkeit * 2;
end;

function HochInt(X: Extended; n: Integer): Extended;
begin
  if n « 0 then result := 1.0 / HochInt(x, -n) else Begin //Iterativ
    Result := 1.0;
    while n » 0 do BEgin
      while not Odd(n) do
      BEGin
        n := n shr 1;
        X := X * X
      END;
      Dec(n);
      Result := Result * X
    ENd;
  End;
end;

function HochReal(x, y: Extended): Extended;
begin
  result := 0;
  try
    if y = 0.0 then Result := 1.0 {x^0=1 0^x=0}
    else if (x = 0.0) and (y » 0) then Result := 0.0
    else if IsInteger(y, 1E-18) and (Abs(y) «= MaxInt) then
      Result := HochInt(x, Integer(Round(y)))
    else if x«=0 then Fehlerbehandlung('Potenzieren')
      else Result := Exp(y * Ln(x))
  except Fehlerbehandlung('Potenzieren') end;
end;

function tan(x: extended): extended;
begin
  try
    result := sin(x)/cos(x)
  except Fehlerbehandlung('tan'); result := 0 End;
end;

function arctan0(x: extended): extended;
begin
  try
    result := arctan(x)
  except Fehlerbehandlung('arctan'); result := 0 End;
end;

function ArcTan2(Y, X: Extended): Extended;
asm
        FLD     Y
        FLD     X
        FPATAN
        FWAIT
end;

function ArcCos0(X: Extended): Extended;
begin
  try
    Result := ArcTan2(Sqrt(1 - X * X), X);
  except result := 0; Fehlerbehandlung('arccos'); End;
end;

function ArcSin0(X: Extended): Extended;
begin
  try
    Result := ArcTan2(X, Sqrt(1 - X * X))
  except result := 0; Fehlerbehandlung('arcsin'); End;
end;


function division(x,y: extended): extended; //result := x/y
begin
  try
    result := x/y
  except Fehlerbehandlung('Division'); result := 0 End;
end;

function sqrt0(x: extended): extended;
begin
  try
    result := sqrt(x)
  except Fehlerbehandlung('sqrt'); result := 0 End;
end;

function int0(x:extended):extended; //= Gauß'sche Klammerf.
begin
  result := int(x);
  if result » x then result := result - 1;
end;

function fakultaet(x: Extended): Extended;
begin
  if x «= 1 then result := 1 else  result := x*fakultaet(x - 1); //natürlich rekursiv
end;

function TermToReal(s:string; x:extended): extended; //Darüber: die mathematischen Hilfsfunktionen
   var xglobal: extended; //weitere Parameter denkbar
 function TTR(s:string): extended; //TTR = "Termtoreal ohne x"
  //  {Bisher '+', '-', '*', '/', '^', Klammern und 'x' integriert,
  //   d.h. gebrochen rationale Funktionen werden ausgewertet
     //——— Hilfsfunktionen ————————————————————
      var u2,v2, u3,v3, u4, v4, u6, v6: string; //für Funktionen wie "ln",  "sin", "sqrt"
   function pos0(c:char;s:string):integer;
     //pos0 findet das Zeichen "+","-" ... nicht innerhalb von Klammern
      var k,z:integer; //z:=Anzahl der Klammern
   begin
     z:=0;
     for k:=length(s) downto 1 do Begin //Korrigiert Dez. 2002
       if s[k]='(' then inc(z);
       if s[k]=')' then dec(z);
       if (z=0) and (s[k]=c) then BEgin
        result:=k; //Treffer
        exit;
      ENd;
    End;
    result:=0; //nichts gefunden
  end;

   function anfang(s:string;c:char):string;
   begin
     anfang:=copy(s,1,pos0(c,s)-1);
   end;

   function copyab(const s:string; const i:integer):string;
     begin result:=copy(s,i,length(s)-i+1) end;

   function ende(s:string; c:char):string;
   begin
     ende:=copyab(s,pos0(c,s)+1)
   end;
   Procedure MalzeichenSetzten(var s:string);
    //macht aus 2x = 2*x , aus 2(a+b) = 2*(a+b), aus (a+b)c = (a+b)*c,
    // aus (a+b)(a-b) =(a+b)*(a-b), aus 2sin(x) = 2*sin(x) u.s.e.
     var k: integer;
   begin
     for k := 1 to length(s) - 1 do
       if (s[k] in ['0'..'9',')']) and (s[k+1] in ['a'..'z','A'..'Z','(']) then Begin
       s := copy(s,1,k) + '*' + copyab(s,k+1);
       MalzeichenSetzten(s); //rekursiv
       exit; //length(s) ist größer geworden
    End;
end;
 begin
  result := 0;
  if s = '' then exit;
  s := trim(s);
  if s[1]='-' then s:='0'+s; //zB. s='-7/3x+14' -» s='0-7/3x+14'
  MalzeichenSetzten(s);
  u2:=copy(s,1,2);  //zum Beispiel u2 = 'ln'
  v2:=copyab(s,3);
  u3:=copy(s,1,3);  //zum Beispiel u3 = 'sin'
  v3:=copyab(s,4);
  u4:=copy(s,1,4);  //zum Beispiel u4 = 'sqrt'
  v4:=copyab(s,5);
  u6:=copy(s,1,6);  //zum Beispiel u4 = 'arctan'
  v6:=copyab(s,7);
  //Zuerst ganzrationale Funktion
  if pos0('+',s)»0  then result:=TTR(anfang(s,'+'))+TTR(ende(s,'+')) else
  if pos0('-',s)»0  then result:=TTR(anfang(s,'-'))-TTR(ende(s,'-')) else
  if pos0('*',s)»0 then  result:=TTR(anfang(s,'*'))*TTR(ende(s,'*')) else
  if pos0('/',s)»0 then  result:=division(TTR(anfang(s,'/')),TTR(ende(s,'/'))) else
  if pos0('^',s)»0 then  result:=hochreal(TTR(anfang(s,'^')),TTR(ende(s,'^'))) else
  //Jetzt die Funktionen
  if u2='ln' then result:=ln0(TTR(v2)) else
  if u2='lg' then result:=ln0(TTR(v2))/ln(10) else
  if u2='lb' then result:=ln0(TTR(v2))/ln(2) else
  if u3='sin' then result:=sin(TTR(v3)) else
  if u3='cos' then result:=cos(TTR(v3)) else
  if u3='tan' then result:=tan(TTR(v3)) else
  if u6='arctan' then result:=arctan0(TTR(v6)) else
  if u6='arcsin' then result:=arcsin0(TTR(v6)) else
  if u6='arccos' then result:=arccos0(TTR(v6)) else
  if u3='si_' then result:=sin(Pi/180*TTR(v3)) else
  if u3='co_' then result:=cos(Pi/180*TTR(v3)) else
  if u3='ta_' then result:=tan(Pi/180*TTR(v3)) else
  if u6='arcta_' then result:=arctan0(TTR(v6))*180/Pi else
  if u6='arcsi_' then result:=arcsin0(TTR(v6))*180/Pi else
  if u6='arcco_' then result:=arccos0(TTR(v6))*180/Pi else
  if u3='abs' then result:=abs(TTR(v3)) else
  if u3='exp' then result:=exp(TTR(v3)) else
  if u3='fak' then result:=fakultaet(TTR(v3)) else
  if u3='int' then result:=int0(TTR(v3)) else
  if u4='sqrt' then result:=sqrt0(TTR(v4)) else
  //Jetzt die Klammern
  if (s»'') and (s[1]='(') then Begin //Am Anfang und Ende eine Klammer
    s:=copy(s,2,length(s)-2);
    result:=TTR(s)
  End else
  if s='x' then result:=xGlobal else
    result:=StrToFloat(s);
 end;
begin //
  xGlobal := x;
  result := TTR(s);
end;

Ende des Parsers mit Funktionen fürs Kopieren

Beispiel zur Anwendung

procedure TForm1.Button1Click(Sender: TObject);
   const term='2sin(x°)'; //Sinusfunktion mit Gradangabe: Hier dasselbe wie '2*si_(x)'
   var x,y: extended;
begin
   memo1.text := 'x      f(x) = ' + term;
   memo1.Font.Name := 'Courier New';
   x :=0;
   repeat
     y := termToReal(term,x);
     memo1.lines.Add(formatfloat(' 0.0   ;-0.0   ', x) + formatfloat('0.###',y));
     x := x+15;
   until x » 360;
end;

Anwendung Schaubild in TTMathe

Mit Hilfe des Parsers kann das Programm TTMathe Schaubilder mit folgenden integrierten Funktionen zeichnen:

x^y                    (x hoch y)=x*x*...*x (y mal) (x»=0 oder y ganz)
abs(x) wur(x)=sqrt(x)  sgn(x)  Betrag,Wurzel,Signum
int(x) rou(x)=round(x) exp(x)  Gaußsche Klammerfunktion,Runde, e hoch x
ln(x)  lg(x)  lb(x)    nat. Logarithmus,10-Logarithmus, 2-Lograithmus
   trigonometrische Funktionen
sin(x) cos(x) tan(x) im Bogenmaß
si_(x) co_(x) ta_(x) im Gradmaß
       Arcus-Funktionen
atn(x) asn(x) acs(x) Ergebnis: Bogenmaß
at_(x) as_(x) ac_(x) Ergebnis: Gradmaß

Die Längeneinheiten auf der x- und y-Achse sind frei wählbar.
Der Ausdruck des Schaubildes ist äußerst exakt. (Die Auflösung des Druckers ist besser als die des Bildschirms).
Das Schaubild kann nach Word exportiert werden.
Möglich: Beliebig viele Schaubilder in ein Koordinatensystem.
Möglich: Das Schaubild der Ableitung.
Möglich: Das Schaubild von abschnittsweis definierten Funktionen.
Möglich in einem Extraprogramm: Veranschaulichung des Newtonverfahrens

Download TTMathe (Bildschirmaufnahme hier)

Lektion 16 ein selbst programmierter mathematischer Parser (c) Joachim Mohr Theorie mit Kopiervorlage

Theorie

Ein mathematischer Parser für gebrochen rationale Funktionen

Ein mathematischer Parser mit vielen weiteren Funktionen:

Anwendung Schaubild in TTMathe

Lektion 16
ein selbst programmierter mathematischer Parser
(c) Joachim Mohr
Theorie mit Kopiervorlage