home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
aosupn.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-11-25
|
12KB
|
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.