Umwandlung Dezimal- in Dualzahlen
![]() |
![]() |
![]() |
Lektion 16
|
![]() |
Die Übernahme des Parsers in andere Programme ist leicht: Kopieren Sie die farbige Kopiervorlage der Funktion TermtoReal mitsamt den Hilfsfunktionen in ihr Programm.
"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
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;
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.
Bei diesem Parser wird gezeigt, wie eine Wertetafel für eine gebrochen rationale Funktion ausgegeben werden kann: Aufruf termtoReal(term,x)
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;
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;
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)
(* (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;
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;
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ß