Turbo Toolbox/Turbo_Toolbox.iso/1988/12/colleg/formel.mod

Text File | 1988-09-20 | 9.9 KB | 375 lines

(*****************************************************************************
 *                           FORMEL.MOD                                      *
 *                        M2Amiga-Compiler                                   *
 * Kern eines Formelinterpreters ohne jegliche Eingabesicherheit, der leicht *
 * fuer eine echte Anwendung ausgebaut werden kann. Saemtliche Zahlen sind   *
 * als REALs einzugeben, z.B. "5.0".                                         *
 *                                                                           *
 *     (C) 1988 TOOLBOX 12'88  & Edgar Meyzis "Der Formelinterpreter"        *
 *****************************************************************************)


MODULE RechenBaum;
FROM MathLib0 IMPORT
        cos, exp, ln, sin; (*darauf beschraenkt da fuer Prinzip hinreichend *)
FROM RealConversions IMPORT
        StrToReal;         (* wandelt STRING in REAL *)
FROM RealInOut IMPORT
        done, ReadReal, WriteReal;
FROM Strings IMPORT
        Compare, Delete, Length;
FROM Storage IMPORT (* Runtime gibt Speicherplatz bei Programmende frei*)
        ALLOCATE;
FROM SYSTEM IMPORT
        ADR, TSIZE;
FROM Terminal IMPORT
        ReadLn, Write, WriteLn, WriteString;


TYPE  STRING         = ARRAY[0..40] OF CHAR; (* begrenzt Formellaenge *)
      MathFunktionen = (SIN, LN, COS); (* hier erweitern; dazu auch FunktTab
                                          initialisieren und Ergebnis ausbauen
                                       *)
      Zeiger         = POINTER TO Knoten;
      Knoten         = RECORD  (* kennen wir doch von Bild 8 !? *)
                          Wert   : REAL;
                          XVar   : BOOLEAN;
                          Operat : CHAR;
                          Links,
                          Rechts : Zeiger
                       END;
VAR   Formel   : STRING;
      Wurzel   : Zeiger;
      CH       : CHAR; (* waere auch ohne gegangen *)
      (* Folgende Tabellen wachsen mit Zunahme von "MathFunktionen mit *)
      FunktTab : ARRAY MathFunktionen OF ARRAY[0..3] OF CHAR;
      OprtrTab : ARRAY MathFunktionen OF CHAR;




MODULE Initialisieren;

IMPORT FunktTab, OprtrTab, MathFunktionen, Write, WriteLn, WriteString;

VAR Index : MathFunktionen;

(* laeuft nach dem Laden des Programms ohne Aufruf automatisch ab. That`s
   Modula. *)
BEGIN
   Write(14C); (* DelScr*) WriteLn; WriteLn; WriteString
   ("RECHENBAUM errichtet aus dem String Y = F(X) einen binären");
   WriteLn; WriteString
   ("Baum, um darin Funktionswerte schnell zu berechnen.");
   WriteLn; WriteLn; WriteLn;
   FunktTab[SIN] := "SIN"; OprtrTab[SIN] := "S";
   FunktTab[LN]  := "LN";  OprtrTab[LN]  := "N";
   FunktTab[COS] := "COS"; OprtrTab[COS] := "C"; (*hier erweitern*)
   WriteString("Programmierte Funktionen: SIN, COS, LN, ^, *, /, +, -");
   WriteLn; WriteLn;
END Initialisieren;




PROCEDURE Abbrechen;
BEGIN
   WriteString("Wegen vermutlich fehlerhafter Eingabe abgebrochen!");
   WriteLn; HALT; (* brutal aber bewusst allgemein gehalten! *)
END Abbrechen;


PROCEDURE FormelEinlesen;
VAR Laenge : INTEGER;

PROCEDURE FormelAufbereiten(VAR String : STRING);

(* Leerzeichen beseitigen und in Grossbuchstaben wandeln, um "FormelLesen"
   zu vereinfachen.
*)
VAR Pos : INTEGER;
BEGIN
   Pos := 0;
   LOOP
      IF String[Pos] = 0C THEN EXIT END;
      String[Pos] := CAP(String[Pos]);
      IF String[Pos] = " " THEN
         Delete(String, Pos, 1);
      ELSE
         INC(Pos)
      END;
   END;
END FormelAufbereiten;

BEGIN (*FormelEinlesen ohne jegliche Eingabesicherheit*)
   WriteString("Y(X) = "); ReadLn(Formel, Laenge);
   FormelAufbereiten(Formel);
END FormelEinlesen;


PROCEDURE BaumErrichten;

VAR Position     : INTEGER; (* innerhalb FormelString*)
    FormelEnde   : BOOLEAN;

PROCEDURE FormelLesen;
BEGIN
   INC(Position);
   IF Formel[Position] # 0C THEN
      CH :=  Formel[Position];
   ELSE
      FormelEnde := TRUE;
   END;
END FormelLesen;

PROCEDURE NEW (VAR Element : Zeiger);
(* M2Amiga unterstⁿtzt nicht NEW *)
BEGIN
   ALLOCATE(Element, TSIZE(Knoten));
END NEW;

PROCEDURE KnotenAnfuegen() : Zeiger;
VAR PZeig : Zeiger;
BEGIN
   NEW(PZeig);
   WITH PZeig^ DO
      Links := NIL; Rechts := NIL;
      XVar  := FALSE;
   END;
   RETURN PZeig;
END KnotenAnfuegen;

PROCEDURE NeuerKnoten (PZeig : Zeiger; Aktion : CHAR;
                       Lesen : BOOLEAN)               : Zeiger;
VAR QZeig : Zeiger;
BEGIN
   NEW(QZeig);
   WITH QZeig^ DO
      Links := PZeig; Operat := Aktion; XVar := FALSE;
   END;
   IF Lesen THEN
      FormelLesen
   END;
   RETURN QZeig;
END NeuerKnoten;

PROCEDURE Term() : Zeiger;
VAR PZeig, QZeig : Zeiger;

PROCEDURE Produkt() : Zeiger;
VAR PZeig, QZeig : Zeiger;


PROCEDURE Exponent() : Zeiger;
VAR PZeig, QZeig : Zeiger;


PROCEDURE VorZeichen() : Zeiger;
VAR PZeig, QZeig : Zeiger;


PROCEDURE Faktor() : Zeiger;
VAR PZeig, QZeig : Zeiger;
    Anfang       : CARDINAL;
    Gefunden     : BOOLEAN;
    TeilForm     : STRING;

PROCEDURE ZiffernUmwandeln;
VAR Fehler : BOOLEAN;
    Index  : CARDINAL;

BEGIN
   PZeig := KnotenAnfuegen();
   Index := 0;
   IF (CH >= "0") AND (CH <= "9") THEN
      LOOP
         CASE Formel[Position] OF
            "0".."9",
            "E", "."  : TeilForm[Index] := Formel[Position];
          | "+", "-"  : IF TeilForm[Index - 1] = "E" THEN
                           TeilForm[Index] := Formel[Position]
                        ELSE
                           EXIT
                        END;
         ELSE
            EXIT
         END;
         INC(Index); INC(Position);
      END;
      TeilForm[Index] := 0C;
      StrToReal(TeilForm, PZeig^.Wert, Fehler);
      IF Fehler THEN
         Abbrechen
      END;
      DEC(Position);
   ELSE (* also X *)
      PZeig^.XVar := TRUE;
   END;
   FormelLesen;
END ZiffernUmwandeln;

PROCEDURE FunktionenAuswerten;
VAR Index   : MathFunktionen;
    Laenge  : CARDINAL;
BEGIN
   Gefunden := FALSE;
   FOR Index := SIN TO MAX(MathFunktionen) DO (*auf Erweiterung eingestellt*)
      IF NOT Gefunden THEN
         Laenge := Length(FunktTab[Index]);
         IF Compare(Formel, Position, Laenge, FunktTab[Index], TRUE) = 0 THEN
            Gefunden := TRUE;
            INC(Position, (Laenge - 1));
            PZeig := KnotenAnfuegen();
            QZeig := NeuerKnoten(PZeig, OprtrTab[Index], TRUE);
            QZeig^.Rechts := Faktor();
            PZeig := QZeig;
         END;
      END;
   END;
   IF NOT Gefunden AND FormelEnde THEN
      Abbrechen
   END;
END FunktionenAuswerten;

BEGIN (*Faktor*)
   IF ((CH >= "0") AND (CH <= "9")) OR (CH = "X") THEN
      ZiffernUmwandeln
   ELSIF CH = "(" THEN
      FormelLesen;
      PZeig := Term();
      IF CH # ")" THEN
         Abbrechen
      END;
      FormelLesen;
   ELSE
      FunktionenAuswerten
   END;
   RETURN PZeig;
END Faktor;

BEGIN (*VorZeichen*)
   (* negatives Vorzeichen wird in der Form (-1 * Ausdruck) berücksichtigt.*)
   IF CH = "-" THEN
      FormelLesen;
      PZeig := KnotenAnfuegen();
      PZeig^.Wert := -1.0;
      QZeig := NeuerKnoten(PZeig, "*", FALSE);
      QZeig^.Rechts := Faktor();
      PZeig := QZeig;
   ELSE
      PZeig := Faktor()
   END;
   RETURN PZeig;
END VorZeichen;

BEGIN (*Exponent*)
   PZeig := VorZeichen();
   IF CH = "^" THEN
      QZeig := NeuerKnoten(PZeig, CH, TRUE);
      QZeig^.Rechts := VorZeichen();
      PZeig := QZeig;
   END;
   RETURN PZeig;
END Exponent;

BEGIN (*Produkt*)
   PZeig := Exponent();
   IF (CH = "*") OR (CH = "/") THEN
      QZeig := NeuerKnoten(PZeig, CH, TRUE);
      QZeig^.Rechts := Exponent();
      PZeig := QZeig;
   END;
   RETURN PZeig;
END Produkt;

BEGIN (*Term*)
   PZeig := Produkt();
   IF (CH = "+") OR (CH = "-") THEN
      QZeig := NeuerKnoten(PZeig, CH, TRUE);
      QZeig^.Rechts := Produkt();
      PZeig := QZeig;
   END;
   RETURN PZeig;
END Term;

BEGIN            (*BaumErrichten ohne Syntax- u. Plausibilitaetspruefungen*)
   Position := -1; (* FormelLesen beginnt bei Formel[0] n. Inkrementierung*)
   FormelLesen;
   Wurzel := Term();
END BaumErrichten;


PROCEDURE FunktionsWert(X : REAL) : REAL;

PROCEDURE BaumDurchrechnen(Wurzel, QZeig : Zeiger);
VAR Oprd1, Oprd2 : REAL;
    PZeig        : Zeiger;

PROCEDURE Ergebnis(Operator : CHAR) : REAL;
(*ausbaubare Grundprozedur, die keine Fehler abfaengt*)
BEGIN
   CASE Operator OF
      "*" : RETURN Oprd1 * Oprd2;
    | "/" : RETURN Oprd1 / Oprd2;
    | "+" : RETURN Oprd1 + Oprd2;
    | "-" : RETURN Oprd1 - Oprd2;
    | "^" : RETURN exp(ln(Oprd1) * Oprd2);
    | "S" : RETURN sin(Oprd2);
    | "C" : RETURN cos(Oprd2);
    | "N" : RETURN ln(Oprd2);
   END;
END Ergebnis;

PROCEDURE OperandWert(PZeig : Zeiger) : REAL;
BEGIN
   WITH PZeig^ DO
      IF XVar THEN
         RETURN X
      ELSE
         RETURN Wert
      END;
   END;
END OperandWert;

BEGIN (*BaumDurchrechnen*)
   IF Wurzel # NIL THEN
      PZeig := QZeig;
      BaumDurchrechnen(Wurzel^.Links, Wurzel);
      IF PZeig # Wurzel THEN
         Oprd1 := OperandWert(Wurzel);
         IF PZeig^.Rechts^.Links # NIL THEN
            BaumDurchrechnen(PZeig^.Rechts, PZeig^.Rechts);
         END;
         Oprd2 := OperandWert(PZeig^.Rechts);
         PZeig^.Wert := Ergebnis(PZeig^.Operat);
      END;
   END;
END BaumDurchrechnen;

BEGIN (*FunktionsWert*)
   BaumDurchrechnen(Wurzel, Wurzel);
   RETURN Wurzel^.Wert;
END FunktionsWert;

PROCEDURE WerteBerechnen;
VAR X : REAL;
BEGIN
   WriteString("Programmabbruch mit <RETURN> möglich.");
   WriteLn; WriteLn;
   LOOP
      WriteString("X = "); ReadReal(X);
      IF NOT done THEN
         HALT
      END;
      WriteString("Y = "); WriteReal(FunktionsWert(X), 8,3);
      WriteLn; WriteLn;
   END;
END WerteBerechnen;


BEGIN (*RechenBaum*)
   FormelEinlesen;
   BaumErrichten;
   WerteBerechnen;
END RechenBaum.