VAL in PASCAL - Umwandlung von Strings in numerische Variablen

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:

Hieraus ergibt sich eine Hierarchie der Rechenoperatoren:

  1. Klammern und Funktionen
  2. Potenz A
  3. Vorzeichen +,-
  4. Punktrechnung *, /
  5. 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.


Klaus Wilczek


Links

Copyright-Bestimmungen: siehe Über diese Seite
Classic Computer Magazines
[ Join Now | Ring Hub | Random | << Prev | Next >> ]