Turbo Toolbox/Turbo_Toolbox.iso/sonderh1/aosupn.pas

Pascal/Delphi Source File | 1986-11-25 | 11.6 KB | 373 lines

{---------------------------------------------------------------------------}
{ Dieses Programm wandelt unter Verwendung der Datentypen 'stack' und 'queue'
  einen mathematichen Ausdruck aus dem Algebraischen-Ordungs-System (AOS) in
  die Umgekehrt-Polnische-Notation um.                                      }

PROGRAM aos_to_upn;

CONST cr = #13;                             { Tastencode fuer ENTER/RETURN  }

TYPE stpointer = ^stelem;                   { Zeiger auf einen Stackeintrag }
     qupointer = ^quelem;                   { Zeiger auf einen Queueeintrag }
     stack = stpointer;                     { Anker des Stacks (oberstes)   }
     queue = RECORD
               head,                        { Anker der Queue: Anfang       }
               tail: qupointer              {                  und Ende     }
             END;
     information = char;
     stelem = RECORD
                info: information;          { Stackelement besteht aus      }
                last: stpointer             { Information und Vorgaenger.   }
              END;
     quelem = RECORD
                info: information;          { Queue-Element besteht aus     }
                next: qupointer;            { Information und Nachfolger.   }
              END;

VAR aos_schlange, upn_schlange: queue;      { zum speichern der Ausdruecke  }

{============================================================================}

{ Die Routinen dieses Abschnittes definieren die Operationen auf den neuen
  Datentyp Schlange. Sie koennen zusammen mit den Typdeklarationen in der
  TYPE-Daklaration auch allgemein verwendet werden, da von der Art der In-
  formation kein Gebrauch gemacht wird. }

{---------------------------------------------------------------------------}

PROCEDURE create_queue (VAR anker: queue);

{ Die einfachste Operation ist das Erzeugen einer Schlange. Sie muss immer
  aufgerufen werden, bevor eine Schlange erstmals verwendet wird. Nach
  dem Aufruf ist die Schlange leer - zum Loeschen empfielt sich diese Proze-
  dur aber nicht, da eventuell Elemente, die in ihr gespeichert sind, danach
  brach liegen.                                                             }

BEGIN
  anker.head := nil;
  anker.tail := nil
END;

{----------------------------------------------------------------------------}

PROCEDURE clear_queue (VAR anker: queue);

{ Diese Prozedur loescht nun eine Schlange, wobei die Speicherplaetze ihrer
  Elemente wiederverwendet werden, also nicht ungenutzt bleiben. }

VAR kopf: qupointer;

BEGIN
  WHILE anker.head <> nil DO
  BEGIN
    kopf := anker.head;
    anker.head := anker.head^.next;
    dispose(kopf)              { ggf. hier explicit_dispose aus der 1. Folge }
  END;
END;

{----------------------------------------------------------------------------}

PROCEDURE enter (VAR anker: queue; info: information);

{ Fuer die Information 'info' wird eine dynamische Variable erzeugt, die an
  die Schlange angehaengt wird.                                              }

VAR schwanz: qupointer;

BEGIN
  new(schwanz);
  schwanz^.info := info;
  schwanz^.next := nil;
  IF anker.head = nil THEN
    anker.head := schwanz
  ELSE
    anker.tail^.next := schwanz;
  anker.tail := schwanz;
END;

{----------------------------------------------------------------------------}

PROCEDURE remove (VAR anker: queue; VAR info: information; VAR err: boolean);

{ Der Kopf der Schlange, also ihr vorderstes und zuerst eingelesenes Element,
  wird abgetrennt und die darin stehende Information in 'info' zurueckgegeben.
  Sollte die Schlange leer sein, wird das Fehlerflag 'err' gesetzt.          }

VAR kopf: qupointer;

BEGIN
  IF anker.head=nil THEN
    err := true
  ELSE
  BEGIN
    err := false;
    kopf := anker.head;
    info := kopf^.info;
    anker.head := anker.head^.next;
    dispose(kopf);                       { ggf. esplicit_dispose aus Folge 1 }
  END;
END;

{----------------------------------------------------------------------------}

PROCEDURE head (VAR anker: queue; VAR info: information; VAR err: boolean);

{ Aehnlich der obigen Prozedur wird auch hier die Information des Kopfelem.
  in 'info' zurueckgegeben und ggf. das Errorflag gesetzt, doch bleibt der
  Eintrag am Kopf der Schlange erhalten.                                     }

BEGIN
  IF anker.head=nil THEN
    err := true
  ELSE
  BEGIN
    err := false;
    info := anker.head^.info;
  END;
END;

{----------------------------------------------------------------------------}

FUNCTION empty_queue (anker: queue): boolean;

{ Diese Funktion gibt zurueck, ob die Schlange leer ist (true) oder mindes-
  tens ein Element enthaelt (false).                                         }

BEGIN
  empty_queue := anker.tail=nil;
END;

{============================================================================}

{ Dieses Modul definiert zusammen mit den TYPE-Deklarationen den Datentyp
  'stack' und seine Operationen. }

{----------------------------------------------------------------------------}

PROCEDURE create_stack (VAR anker: stack);

{ Vor der ersten Benutzung eines stack muss dieser erzeugt werden. Bezueglich
  des Loeschens siehe 'create_queue'.                                        }

BEGIN
  anker := nil;
END;

{----------------------------------------------------------------------------}

PROCEDURE clear_stack (VAR anker: stack);

{ Diese Prozedur loescht nun einen Stack und gibt die von ihm belegten
  Speicherplaetze zur Wiederverwendung frei.                                 }

VAR top: stpointer;

BEGIN
  WHILE anker <> nil DO
  BEGIN
    top := anker^.last;
    dispose(anker);                      { ggf. explicit_dispose aus Folge 1 }
    anker := top;
  END;
END;

{----------------------------------------------------------------------------}

PROCEDURE push (VAR anker: stack; info: information);

{ Fuer die uebergebene Information wird eine dynamische Variable erzeugt und
  diese auf den Stapel gelegt.                                               }

VAR top: stpointer;

BEGIN
  top := anker;
  new(anker);
  anker^.info := info;
  anker^.last := top;
END;

{----------------------------------------------------------------------------}

PROCEDURE pop (VAR anker: stack; VAR info: information; VAR err: boolean);

{ Als Gegenstueck zu 'push' wird hier das oberste Element vom Stapel genommen
  und seine Information zurueckgegeben. Ist der Stapel leer, wird das
  Errorflag gesetzt.                                                         }

VAR top: stack;

BEGIN
  IF anker = nil THEN
    err := TRUE
  ELSE
  BEGIN
    err := false;
    info := anker^.info;
    top := anker^.last;
    dispose(anker);
    anker := top;
  END;
END;

{----------------------------------------------------------------------------}

FUNCTION empty_stack (anker: stack): BOOLEAN;

{ Ist der Stack leer, dann wird true, sonst true zurueckgegeben.             }

BEGIN
  empty_stack := anker=nil;
END;

{----------------------------------------------------------------------------}

PROCEDURE tos (anker: stack; VAR info: information; VAR err: boolean);

{ Ohne das oberste Element vom Stapel zu entfernen, wird seine Information
  zurueckgegeben und ggf. das Errorflag gesetzt.                             }

BEGIN
  IF anker=nil THEN
    err := true
  ELSE
  BEGIN
    err := false;
    info := anker^.info;
  END;
END;

{============================================================================}

{ Dieses Modul stellt Ein- und Ausgaberoutinen fuer genau die Schlangen zur
  Verfuegung, die in diesem Programm gebraucht werden, naemlich mit Elementen
  vom Typ 'char'. }

{----------------------------------------------------------------------------}

PROCEDURE lese (VAR schlange: queue);

{ Es wird eine Folge der moeglichen Zeichen eingelesen und diese in eine
  Schlange geschrieben, bei Fehlerhafter Eingabe wird das betreffende Zeichen
  ignoriert, es gibt keine Fehlermeldung. Die Eingabe wird durch '=' beendet.
  Die Dateiangabe 'trm' ermoeglicht in Turbo-Pacal die zeichenweise Eingabe
  mit Bildschirmecho.                                                        }

VAR info: information;

BEGIN
  create_queue(schlange);
  REPEAT
    Read(trm, info);
    IF info IN ['a'..'z', '+', '-', '*', '/', '^', '=', '(', ')'] THEN
    enter(schlange, info)
  UNTIL info = '=';
  WriteLn;
END;

{----------------------------------------------------------------------------}

PROCEDURE schreibe (schlange: queue);

{ Die uebergebene Schlange wird auf den Bildschirm ausgegeben.               }

VAR info: information;
    err: BOOLEAN;

BEGIN
  remove(schlange, info, err);
  WHILE NOT(err) DO
  BEGIN
    write(info);
    remove(schlange, info, err);
  END;
  WriteLn;
END;

{============================================================================}

{ Die folgenden Routinen bearbeiten die Anwendung: 'Umwandlung AOS-UPN',
  dabei werden die oben definierten Datentypen 'stack' und 'queue' mit ihren
  Operationen verwendet. }

{----------------------------------------------------------------------------}

FUNCTION prio (op: CHAR): INTEGER;

{ Diese Funktion gibt die Prioritaet einer mathematischen Operation zurueck.
  Je hoeher der zurueckgegebene Wert, desto vorrangiger wird die Operation
  ausgefuehrt.                                                               }

BEGIN
  CASE op OF
    '('    : prio := 0;
    '+','-': prio := 1;
    '*','/': prio := 2;
    '^'    : prio := 3;
  END;
END;

{----------------------------------------------------------------------------}

PROCEDURE aos_to_upn (aos: queue; VAR upn: queue);

{ Hier findet die eingentliche Umwandlung der AOS-Darstellung in UPN statt.
  Der Algorithmus ist im Begleittext naeher erklaert. Es findet keine Kon-
  trolle auf Korrektheit des AOS-Ausdrucks statt!                            }

VAR top: information;
    stapel: stack;
    err: BOOLEAN;
    info: information;

BEGIN
  create_stack(stapel);
  create_queue(upn);
  remove(aos, info, err);
  push(stapel, '(');
  WHILE NOT(err) DO
  BEGIN
    CASE info OF
      'a'..'z'           : enter(upn,info);
      '+','-','*','/','^': BEGIN
                             tos(stapel, top, err);
                             WHILE prio(info) < prio(top) DO
                             BEGIN
                               pop(stapel, top, err);
                               enter(upn, top);
                               tos(stapel, top, err);
                              END;
                              push(stapel, info);
                            END;
      '('                : push(stapel, info);
      ')','='            : BEGIN
                             pop(stapel, top, err);
                             WHILE top <> '(' DO
                             BEGIN
                               enter(upn, top);
                               pop(stapel, top, err);
                             END;
                           END;
    END;
    remove(aos, info, err);
  END;
END;

{============================================================================}

BEGIN
  WriteLn;
  WriteLn('*** Programm zur Umwandlung von AOS in UPN');
  WriteLn;
  WriteLn('Es koennen nur Ausdruecke bestehend aus Buchstaben (a..z),');
  WriteLn('den Operationen +, -, *, / und ^ sowie Klammern ( ) verwendet');
  WriteLn('werden, fehlerhafte Zeichen werden ignoriert.');
  WriteLn;
  Write('AOS: ');
  lese(aos_schlange);
  aos_to_upn(aos_schlange, upn_schlange);
  write('UPN: ');
  schreibe(upn_schlange);
END.