Als ich vor einiger Zeit anfing Mathematikprogramme zu schreiben, mußte ich feststellen, daß mir CCD Pascal+ nicht alle nötigen Hilfsmittel zur Verfügung stellte. Ich setzte mich also hin und schrieb zunächst eine VAL-Routine, wie sie mir von Basic aus bekannt war. Diese Routine ist als Include-Datei ausgelegt.
Die dazugehörige Datei hat den Namen VALUE.INC. Sie macht aus einem übergebenen Stringwert einen Realwert, falls dies möglich ist. Sollte eine Umwandlung nicht möglich sein, so enthält die global zu deklarierende Variable ‘Fehler’, die vom Typ Boolean sein muß, den Wert ‘FALSE’, ansonsten ist sie ‘TRUE’. Ich bin bei dieser Routine einige Kompromisse in puncto Codelänge und Rechengeschwindigkeit eingegangen, wodurch sich eine Zeit von ca. 10 ms für die Umwandlung eines 13-stelligen Strings(-123.4567E-16) ergibt. Das Prinzip der Umwandlung beruht auf der systematischen Zerpflückung des Strings und ist an und für sich leicht zu durchblicken. Das Programm CHR_REAL.PAS ist ein kleines Demoprogramm für VALUE.INC und wandelt die eingegebenen Strings in Realwerte um, bis man als String den Wert ‘ENDE’ eingibt. In das Programm CHR_REAL ist noch eine Procedure eingebaut, die alle Kleinbuchstaben in Großbuchstaben umwandelt, wodurch es egal wird, wie die Tastatur gerade eingestellt ist. Die Value-Routine wird folgendermaßen angewendet:
VALUE.INC
{Value-Routine von Klaus Wilczek für ST Pascal+}
{wanden von Strings in Realwerte}
FUNCTION VAL(X:STRING):REAL;
VAR I1,12:STRING;
TESTWORD:STRING;
N,LE,El,R,EX,KO,VM,VE:INTEGER;
M,I3,I4:REAL;
PROCEDURE INT(R:INTEGER);{Erstellen der Zahlenwerte}
BEGIN
IF FEHLER<>FALSE THEN
BEGIN
I3:=0;
IF KO=0 THEN
FOR R:=1 TO LENGTH(I1) DO
I3:=I3*10 + ORD(I1[R])-48
ELSE
BEGIN
FOR R:= 1 TO (KO-1) DO
I3:=I3*10 + ORD (11[R])-48;
14:=0;
FOR R:= LENGTH (II) DOWNTO (KO+1) DO
I4:=(I4+ORD(I1[R])-48)/10;
I3:=I3+I4;
END;
END;
END;
PROCEDURE SYNTAXCHECK(TESTWORD:STRING;KO:INTEGER);
{Syntaxkontrolle}
VAR I,W:INTEGER;
BEGIN
IF KO >0 THEN DELETE (TESTWORD, KO, 1) ;
IF TESTWORD='' THEN FEHLER:=FALSE ELSE
FOR I := 1 TO LENGTH(TESTWORD) DO
BEGIN
W:=ORD(TESTWORD[I])-48;
IF (W<0) OR (W>9) THEN FEHLER:=FALSE;
END;
END;
BEGIN
FEHLER:=TRUE;
REPEAT {löschen der Leerstellen}
N:=POS(' ',X);
IF (N=1) THEN DELETE(X, N, 1) ;
UNTIL (N>1) OR (N=0) ;
IF (POS (' ',X)>0) THEN DELETE (X, N, LENGTH (X)-N+l) ;
IF POS('-',X)=1 THEN {suchen der Vorzeichen}
BEGIN
VM:=-1;
DELETE(X,1,1)
END
ELSE VM:=1;
KO := POS('.', X) ;
EX := POS('E' ,X) ;
IF EX = 0 THEN
BEGIN {herstellen von Mantisse und Exponent}
I1:=COPY(X,1,LENGTH(X));
I2:='0';
END
ELSE
BEGIN
I1:=COPY(X,1, EX-1) ;
I2:=COPY(X,EX+1,LENGTH(X)-EX};
VE:=1;
IF (I2[1]='-') THEN VE:=1;
IF (VE=-1) OR (I2[1]='+') THEN DELETE (I2, 1,1);
END;
TESTWORD:=CONCAT(I1,I2);
SYNTAXCHECK(TESTWORD,KO);
INT(R); M:=I3; I1:=I2;
K0:=0; INT(R);
E1:=TRUNC(I3);
IF VE = 1 THEN VAL:= (M*VM) *PwrOfTen (E1)
{herstellen der Realwerte}
ELSE VAL: = (M*VM) * (1 /PwrOfTen (E1) ) ;
IF FEHLER=FALSE THEN VAL:=0;
END;
dest := val(source);
dest - Real
source - String
Die Routine führt vor der Umwandlung eine grobe Syntaxkontrolle durch, wodurch die Gefahr eines eventuell auftretenden Fehlers sehr gering sein dürfte. Wird die Datei in irgendwelche Programme eingefügt, lassen sich z.B. Eingaben schnell auf ihre Richtigkeit prüfen, wodurch sich viele Fehler vermeiden lassen.
Weiterhin war ich seit einiger Zeit auf der Suche nach einem guten Algorithmus für einen ()Funktionsinterpreter. Als ich dann auf die Zeitschrift MC, Ausgabe 5/87 aufmerksam gemacht wurde, beschloß ich, den dort in Turbo-Pascal geschriebenen FI() in ST Pascal+ umzuschreiben. Hierbei zeigten sich die Differenzen zwischen den beiden Programmiersprachen doch recht deutlich, es mußte jedoch nicht allzuviel umgeändert werden. Das Resultat war ein recht gut und schnell funktionierender FI. Hier wird ebenfalls die VAL-Routine benutzt, die ja ansonsten bei Turbo-Pascal bereits zur Verfügung steht. Die Aufgabe des FI ist es, einen beliebigen Funktionstherm als String einzulesen, diesen zu analysieren, auf Syntaxfehler zu kontrollieren und zuzulassen, daß beliebige X-Werte eingesetzt werden können bzw. die dazugehörigen Funktionswerte errechnet werden.
Ein Fl muß die üblichen Rechenregeln beherrschen:
- Punkt- vor Strichrechnung
- Klammern zuerst
- von links nach rechts
Hieraus ergibt sich eine Hierarchie der Rechenoperatoren:
- Klammern und Funktionen
- Potenz A
- Vorzeichen +,-
- Punktrechnung *, /
- Strichrechnung +,-
Aus der Funktion wird hier ein Baum gebaut, wobei die Knoten des Baumes durch Operatoren, Funktionen, Vorzeichen, Zahlen und Variablen belegt sind. Die Knoten sind als Variante Records deklariert. Der Baum wird von den höherwertigen Operationen hin zu den nieder-wertigeren durchgearbeitet. Das Programm FUNKTION.TOS erlaubt es, Funktionen einzugeben und Funktionswerte zu berechnen. Leider mußte ich feststellen, daß die mathematischen Funktionen von ST Pascal-»- sehr ungenau sind(z.B. 2A16=65535.99..), und ich will dies noch ändern. Alle bisher angebotenen Algorithmen sind aber entweder selber zu ungenau oder zu umfangreich programmiert, so daß ich es selber probieren will. Mit diesen beiden Funktionen kann bestimmt jeder, der irgendwann einmal mathematische Programme schreiben will, etwas anfangen. Die Programme sollten als TOS-Anwendungen compiliert werden, da ich auf Bildschirmaufbau keinen großen Wert gelegt habe.
CHR_REAL.PAS
{Programm zum testen von VALUE.INC geschrieben von Klaus Wilczek}
PROGRAM TEST_VALUE;
VAR X:STRING;
FEHLER:BOOLEAN; {globale Deklaration der Variablen Fehler}
{$1 VALUE.INC}
PROCEDURE UPPER;{Umwandlung aller Kleinbuchstaben in Gro_buchstaben}
{Die Variable (hier X) mu_ jeweils angepasst werden}
VAR I:INTEGER;
BEGIN
FOR I:=1 TO LENGTH(X) DO
IF (ORD(X{I])>96) AND (ORD(X[I])<123) THEN
BEGIN
INSERT(CHR(ORD(X[I])-32),X, I);
DELETE(X,1+1,1);
END;
END;
BEGIN
WRITELN('Beenden des Programms mit "Ende" !');
REPEAT
WRITELN;WRITE('Bitte einen Wert eingeben : ');
READLN(X);
UPPER;{ alle Kl.bst. werden umgewandelt in Gr.bst.}
IF X<>'ENDE' THEN
BEGIN
WRITELN; WRITELN ( ' X als Stringwert : ', X) ;
WRITELN ; WRITELN('- Umgewandelt zu einem Realwert: VAL(X));
WRITELN; WRITELN(' Fehlervariable : ',FEHLER);
END;
UNTIL X='ENDE';{aussteigen wenn X='ENDE'}
END.
FUNKTION.PAS
PROGRAM FORMELINTERPRETER;
TYPE ARTTYP = (VORZEICHEN,OPERATOR,FUNKTION,ZAHL, VARX);
STRING128 » STRING[128];
OPTYP = SET OF CHAR;
PTR = ^KNOTENTYP;
KNOTENTYP - RECORD CASE ART:ARTTYP OF
VORZEICHEN : (VON:PTR);
OPERATOR : (OP:CHAR; LINKS,RECHTS:PTR);
FUNKTION : (FN:STRING[6];
NEXT:PTR);
ZAHL : (ZA:REAL);
VARX : (X:REAL);
END;
VAR X,Y : REAL;
WAHL : CHAR;
FKT : PTR;
TERM : STRING128;
FEHLER : BOOLEAN;
{$1 VALUE.INC}
FUNCTION SUCHEOPERATOR (OPS:OPTYP; VAR K:INTEGER;
TERM:STRING128):BOOLEAN;
VAR KLAMMER:INTEGER;GEFUNDEN:BOOLEAN;
BEGIN
GEFUNDEN:=FALSE;KLAMMER:=0;K:=LENGTH (TERM)+1;
REPEAT
K:=K-1;
IF TERM[K]=' (' THEN KLAMMER:=PRED(KLAMMER);
IF TERM[K]=')' THEN KLAMMER:=SUCC(KLAMMER);
IF (KLAMMER=0) AND (TERM[K]IN OPS)AND(K>1)
AND(NOT(TERM[K-1]IN['E' , '^'])) THEN GEFUNDEN:=TRUE;
UNTIL GEFUNDEN OR (K=1);
SUCHEOPERATOR:=GEFUNDEN;
END;
FUNCTION SUCHEPLUSMINUS(VAR K:INTEGER;TERM:STRING128):
BOOLEAN;
BEGIN
SUCHEPLUSMINUS:=SUCHEOPERATOR(['+','-'],K,TERM);
END;
FUNCTION SUCHEMALDURCH(VAR K:INTEGER;TERM:STRING128):
BOOLEAN;
BEGIN
SUCHEMALDURCH:=SUCHEOPERATOR(['*', '/'],K,TERM);
END;
FUNCTION SUCHEVORZEICHEN(TERM:STRING128):BOOLEAN;
BEGIN
SUCHEVORZEICHEN:=(TERM[1] IN ['+', '-'])
END;
FUNCTION SUCHEPOTENZ(VAR K:INTEGER;TERM:STRING128): BOOLEAN;
BEGIN
SUCHEPOTENZ:=SUCHEOPERATOR(['^'],K,TERM);
END;
FUNCTION SUCHEFUNKTION(VAR K:INTEGER;TERM:STRING128): BOOLEAN;
VAR F:STRING128;
BEGIN
SUCHEFUNKTION:=FALSE;K:=POS('(', TERM);
IF K>0 THEN
BEGIN
F:=COPY(TERM,1,K-1);
IF((F='ABS')OR(F='ARCTAN')OR(F='COS')OR(F='EXP')OR
(F='FRAC')OR (F='INT')OR(F='LN')OR(F='SIN')OR(F='SQR')OR
(F='SQRT')OR (F=' TAN')OR(F=''))AND(TERM[LENGTH(TERM)]=')')
THEN SUCHEFUNKTION:=TRUE
END;
END;
FUNCTION SUCHEZAHL(VAR WERT:REAL; TERM:STRING128): BOOLEAN;
BEGIN
WERT: VAL (TERM);
SUCHEZAHL:=FEHLER;
END;
FUNCTION SUCHEX(TERM:STRING128):BOOLEAN;
BEGIN
SUCHEX: = (TERM=' X') ;
END;
FUNCTION FUNKTIONSANALYSE(TERM:STRING128):PTR;
VAR TERMOK:BOOLEAN;FKT: PTR;
PROCEDURE BAUEBAUM( VAR KNOTEN:PTR; TERM:STRING128);
VAR WERT:REAL; K:INTEGER; VZ:CHAR;
BEGIN
IF TERMOK AND (LENGTH(TERM)>0) THEN
IF SUCHEPLUSMINUS(K,TERM) THEN BEGIN
NEW(KNOTEN);
KNOTEN^.ART:=OPERATOR; KNOTEN^.OP:=TERM[K];
BAUEBAUM(KNOTEN^.LINKS ,COPY(TERM,1,K-1));
BAUEBAUM(KNOTENA.RECHTS, COPY(TERM,K+1,LENGTH(TERM)-K));
END
ELSE IF SUCHEMALDURCH (K, TERM) THEN
BEGIN
NEW(KNOTEN);
KNOTEN^.ART:=OPERATOR; KNOTEN^.OP:=TERM[K];
BAUEBAUM(KNOTEN^.LINKS ,COPY(TERM,1,K-1));
BAUEBAUM(KNOTEN^.RECHTS, COPY(TERM,K+1,LENGTH(TERM)-K));
END
ELSE IF SUCHEVORZEICHEN (TERM) THEN BEGIN
VZ:=TERM[1]; DELETE(TERM,1,1);
CASE VZ OF
'+': BAUEBAUM(KNOTEN, TERM);
'-': BEGIN
NEW(KNOTEN); KNOTEN^.ART:VORZEICHEN;
BAUEBAUM(KNOTEN^.VON, TERM);
END;
END
END
ELSE IF SUCHEPOTENZ (K, TERM) THEN BEGIN
NEW(KNOTEN);
KNOTEN^.ART:=OPERATOR; KNOTENA.OP:=TERM[K];
BAUEBAUM(KNOTEN^.LINKS ,COPY(TERM,1,K-1));
BAUEBAUM(KNOTEN^.RECHTS, COPY(TERM,K+1,LENGTH(TERM)-K));
END
ELSE IF SUCHEFUNKTION (K, TERM) THEN BEGIN
NEW(KNOTEN);
KNOTEN^.ART:^FUNKTION;
KNOTEN^.FN:=COPY(TERM,1,K-1);
BAUEBAUM(KNOTEN^.NEXT, COPY(TERM,K+1,LENGTH(TERM)-1-K));
END
ELSE IF SUCHEZAHL (WERT, TERM) THEN BEGIN NEW(KNOTEN);
KNOTEN^.ART:=ZAHL; KNOTEN^.ZA:=WERT;
END
ELSE IF SUCHEX (TERM) THEN BEGIN
NEW(KNOTEN);
KNOTEN^.ART:=VARX;
END
ELSE TERMOK:=FALSE
ELSE TERMOK:=FALSE;
END;
PROCEDURE UPPER;
VAR I:INTEGER;
BEGIN
FOR I:=1 TO LENGTH (TERM) DO
IF (ORD(TERM(I])>96) AND
(ORD(TERM[I])<123) THEN
BEGIN
INSERT(CHR(ORD(TERM[I])-32),TERM,I);
DELETE(TERM,1+1,1);
END;
END;
BEGIN
TERMOK:=TRUE; UPPER;
BAUEBAUM(FKT,TERM);
IF NOT TERMOK
THEN FUNKTIONSANALYSE:=NIL
ELSE FUNKTIONSANALYSE:=FKT;
END;
FUNCTION FUNKTIONSBERECHNUNG(FKT:PTR;X:REAL) :REAL;
CONST MAXREAL=1.0E30; MINREAL=1.0E-30;
VAR WERTOK:BOOLEAN;
FUNCTION WERT(ZEIGER:PTR):REAL;
VAR TEST,FX:REAL;
BEGIN
FX:=X;
IF WERTOK THEN
WITH ZEIGER^ DO
CASE ART OF
VORZEICHEN: WERT:=-WERT(VON);
OPERATOR:CASE OP OF
'+':WERT:=WERT(LINKS)+WERT(RECHTS);
'-':WERT:=WERT(LINKS)-WERT(RECHTS);
'*':WERT:=WERT(LINKS)*WERT(RECHTS);
'/': BEGIN
TEST:=WERT(RECHTS);
IF ABS(TEST)>MINREAL
THEN WERT:=WERT(LINKS)/TEST
ELSE WERTOK:=FALSE ;
END;
'^':BEGIN
TEST:=WERT(LINKS);
IF TEST>MINREAL
THEN WERT:=EXP(WERT(RECHTS)* LN(TEST))
ELSE WERTOK:=FALSE;
END;
END;
FUNKTION: BEGIN
IF FN='' THEN WERT:=WERT(NEXT);
IF FN='ABS' THEN
WERT:=ABS(WERT(NEXT));
IF FN='ARCTAN'THEN
WERT:=ARCTAN(WERT(NEXT));
IF FN='COS' THEN
WERT: COS(WERT(NEXT));
IF FN='EXP' THEN
WERT:=EXP(WERT(NEXT));
IF FN='LN' THEN BEGIN
TEST:=WERT(NEXT);
IF TEST>0
THEN WERT:=LN(TEST)
ELSE WERT OK:=FALSE;
END;
IF FN='SIN' THEN
WERT:=SIN(WERT(NEXT) ) ;
IF FN='SQR' THEN
WERT:=SQR(WERT(NEXT) ) ;
IF FN='SQRT' THEN BEGIN
TEST:=WERT(NEXT);
IF TEST>0
THEN WERT:=SQRT(TEST)
ELSE WERT OK:=FALSE;
END;
IF FN='TAN' THEN
WERT:=SIN(WERT(NEXT))/COS(WERT(NEXT) );
END;
ZAHL: WERT:=ZA;
VARX: WERT:=FX;
END;
END;
BEGIN
IF FKT<>NIL THEN BEGIN
WERTOK:=TRUE; FUNKTIONSBERECHNUNG:=WERT(FKT);
IF NOT WERTOK THEN FUNKTIONSBERECHNUNG:=MAXREAL
END
ELSE FUNKTIONSBERECHNUNG:=MAXREAL;
END;
PROCEDURE clear_line; BEGIN write (chr (27), '1') END;
PROCEDURE gotoxy (x, y: integer);
BEGIN IF x < 0 THEN x := 0
ELSE IF x > 79 THEN x := 79;
IF y < 0 THEN y := 0
ELSE IF y > 24 THEN y := 24;
write (Chr (27), 'Y', chr (y + 32), chr (x +
END;
BEGIN
REPEAT
GOTOXY(3,2);WRITE('Interative Funktionseingabe');
GOTOXY(3,4);WRITE('<1> Term eingeben');
GOTOXY(3,5);WRITE('<2> Funktionswerte');
GOTOXY(3,6);WRITE('<3> Ende');
REPEAT
GOTOXY (7,9) ;CLEAR_LINE;WRITE ('Ihre Wahl: ');
READ(WAHL);CLEAR_LINE;
UNTIL WAHL IN ['1'..'3'];GOTOXY(7,9);
CASE WAHL OF
'1' : BEGIN
WRITE ('Funktionsterm: f(x)= ');
READLN(TERM);CLEAR_LINE;
FKT:=FUNKTIONSANALYSE(TERM);
IF FKT=NIL THEN BEGIN
GOTOXY(7,11);WRITE('FEHLER IN TERM');
READLN;CLEAR_LINE;END;
END;
'2': BEGIN
IF FKT<>NIL THEN BEGIN
WRITE('X = ');
GOTOXY(11,9);READLN(X);CLEAR_LINE;
Y:=FUNKTIONSBERECHNUNG(FKT,X);
GOTOXY(0,11);CLEAR_LINE;GOTOXY(11,11);
WRITELN('f(X)= ',Y);
END
ELSE BEGIN
GOTOXY (7,11); CLEAR_LINE;
WRITE('KEINE FUNKTION DA.');
END;
READLN;
END;
END;
UNTIL WAHL='3';
END.