home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
binbaum.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
10KB
|
286 lines
{========================== PROGRAMM BINAERE BAEUME =========================}
{ Dieses ist das Rahmenprogramm zur Demonstration der Einfuege-, Loesch-
und Suchprozeduren in binaeren Baeumen. Dabei wird der Baum nach jeder
Aenderung graphisch und sequentiell dargestellt, soweit es die Bedingungen
(Bildschirmformat, Aufloesung) erlauben. Es stehen zwei getrennte Moduln
zur Verfuegung, die die Prozeduren zum Loeschen, Einfuegen und Suchen ent-
halten. Das eine benutzt Rekursion ausschliesslich 'herabsteigend', also
ohne VAR-Parameter, so dass sie auch mit Turbo-Pascal unter CP/M 80
lauffaehig sind. Das zweite Modul ist rekursiv implementiert, ist also unter
einigen Pascal-Compilern nicht lauffaehig. Dafuer bietet es immer
AVL-ausgeglichene Baeume. Zu beachten sind einige Anpassungen an das
jeweils gewaehlte Modul, die alle im Programmtext gekennzeichnet sind. }
{$S+} { schaltet bei Pascal MT+ die Erzeugung rekursiven Codes ein }
PROGRAM binaere_baeume (INPUT, OUTPUT);
CONST dc2 = 18; { ASCII 18, loescht vom Cursor bis Zeilenende }
ff = 12; { ASCII 12, loescht den Bildschirm }
TYPE key = CHAR;
side = (left, none, right);
information = RECORD
stichwort: key { nach Bedarf erweiterbar }
END;
tree = ^node;
node = RECORD
info: information;
links, rechts: tree;
{ schiefe: side } { nur fuer AVL }
END;
VAR baum: tree;
stichwort: key;
befehl: CHAR;
neuinfo: information;
{ dummy: BOOLAEN; } { nur fuer AVL }
@SFP: EXTERNAL INTEGER; { Stackadresse fuer Pascal MT+ }
{----------------------------------------------------------------------------}
{ Der jetzt folgende Teil ist Implementationsabhaengig und je nach Compiler/
Hardware anzupassen. Die hier angegebenen Prozeduren gelten fuer Pascal
MT+. }
{----------------------------------------------------------------------------}
{ BDOS-Funktionsaufruf: }
EXTERNAL FUNCTION @BDOS (func: INTEGER; parm: WORD): INTEGER;
{----------------------------------------------------------------------------}
{ Cursor an Position Spalte x und Zeile y setzen. Die linke obere Ecke ent-
spricht der Koordinate 1,1 }
PROCEDURE GotoXY (x, y: INTEGER);
VAR dummy: INTEGER;
BEGIN
dummy := @BDOS (6, wrd(31));
dummy := @BDOS (6, wrd(x));
dummy := @BDOS (6, wrd(y));
END;
{----------------------------------------------------------------------------}
{ ein Zeichen von der Tastatur lesen und auf den Bildschirm 'echoen'. Dabei
ist kein RETURN/ENTER nach dem Zeichen notwendig! }
PROCEDURE GetChar (VAR c: CHAR);
BEGIN
REPEAT
c := Chr (@BDOS (6, wrd($FF)));
UNTIL c <> Chr(0);
Write (c);
END;
{----------------------------------------------------------------------------}
{ Die Zeilen 'von' bis 'bis' des Bildschirms loeschen: }
PROCEDURE ClrLines (von, bis: INTEGER);
VAR l: INTEGER;
BEGIN
GotoXY (1, von);
FOR l := von TO bis DO
WriteLn (chr (dc2));
GotoXY (1, von);
END;
{----------------------------------------------------------------------------}
{ gesamten Bildschirm loeschen: }
PROCEDURE ClrScr;
BEGIN Write (Chr (ff)) END;
{----------------------------------------------------------------------------}
{ Ende des implementatiosabhaengigen Teiles }
{----------------------------------------------------------------------------}
PROCEDURE message (number: INTEGER);
BEGIN
GotoXY (1, 24); Write ('Stichwort ');
CASE number OF
0: Write ('wurde nicht gefunden.');
1: Write ('wird eingetragen.');
2: Write ('wird geloescht.');
3: Write ('wurde gefunden.');
4: Write ('ist vorhanden.')
END;
Write (' ');
END;
{----------------------------------------------------------------------------}
PROCEDURE lese_info (VAR info: information);
BEGIN
{ normalerweise steht hier die Routine zum Lesen des kompletten
Datensatzes ohne das Stichwort. In diesem Beispiel gibt es aber nur
das Stichwort als einzige Information. }
END;
{----------------------------------------------------------------------------}
{ Information des Knotens ausgeben. Hier gleichzeitig das Stichwort. }
PROCEDURE schr_info (info: information);
BEGIN
Write (info.stichwort);
END;
{----------------------------------------------------------------------------}
{ Im Normalfall weitere Informationen zum zu speichernden Stichwort einlesen
(s. 'lese_info'): }
PROCEDURE restinfo (stichwort: key; VAR info: information);
BEGIN
info.stichwort := stichwort;
lese_info (info);
END;
{----------------------------------------------------------------------------}
{ Der Baum wird graphisch auf dem Bildschirm dargestellt. Je nach Rechner
sind die Graphikzeichen zu aendern. Auf eine naehere Erklaerung der Arbeits-
weise dieser Prozedur wird verzichtet, sie dient nur der Verdeutlichung
der Vorgaenge bei den Baumoperationen. }
PROCEDURE schr_baum (baum: tree; dichte, x, y: INTEGER);
{ CPC IBM-PC }
CONST pu = 241; { Pfeil nach unten 193 }
wl = 154; { waagerechte Linie 196 }
sl = 149; { senkrechte Linie 179 }
sa = 148; { senkrechte Linie, oben abgebrochen 179 }
ru = 150; { Winkel von rechts nach unten 218 }
lu = 156; { Winkel von links nach unten 191 }
ro = 147; { Winkel von rechts nach oben 192 }
lo = 153; { Winkel von links nach oben 217 }
VAR dx, xi: INTEGER;
BEGIN
GotoXY (x, y); Write (Chr (pu));
GotoXY (x, y+1); Write (baum^.info.stichwort);
{ nur bei AVL-Baeumen Kommentar-Klammern entfernen !
GotoXY (x, y+2);
CASE baum^.schiefe OF
right: Write ('\');
none: Write ('|');
left: Write('/');
END;
}
dx := 20 DIV dichte;
IF dx = 0 THEN
BEGIN
GotoXY (x, y-1); Write (Chr (sl));
END;
IF (baum^.links <> nil) AND (dichte < 32) THEN { linker Ast }
BEGIN
FOR xi := x-dx+1 TO x-2 DO
BEGIN
GotoXY (xi, y+2); Write (Chr (wl));
END;
GotoXY (x-1, y+2); Write (Chr (lo));
GotoXY (x-1, y+1); Write (Chr (sa));
GotoXY (x-dx, y+2); Write (Chr (ru));
schr_baum (baum^.links, 2*dichte, x-dx, y+3); { linker Sohn }
END;
IF (baum^.rechts <> nil) AND (dichte < 32) THEN { rechter Ast }
BEGIN
FOR xi := x+2 TO x+dx-1 DO
BEGIN
GotoXY (xi, y+2); Write(Chr (wl));
END;
GotoXY (x+1, y+2); Write (Chr (ro));
GotoXY (x+1, y+1); Write (Chr (sa));
GotoXY (x+dx, y+2); Write (Chr (lu));
schr_baum (baum^.rechts, 2*dichte, x+dx, y+3); { rechter Sohn }
END;
END;
{----------------------------------------------------------------------------}
PROCEDURE preorder (baum: tree);
BEGIN
IF baum <> nil THEN
BEGIN
schr_info (baum^.info);
preorder (baum^.links);
preorder (baum^.rechts);
END;
END;
PROCEDURE inorder (baum: tree);
BEGIN
IF baum <> nil THEN
BEGIN
inorder (baum^.links);
schr_info (baum^.info);
inorder (baum^.rechts);
END;
END;
PROCEDURE postorder (baum: tree);
BEGIN
IF baum <> nil THEN
BEGIN
postorder (baum^.links);
postorder (baum^.rechts);
schr_info (baum^.info);
END;
END;
{----------------------------------------------------------------------------}
{ An dieser Stelle muss das gewuenschte Modul zum Einfuegen, Loeschen und
Suchen eingefuegt werden, was z. B. so funktionieren koennte: }
{$I baum-els.inc} { bzw. $I avlb-els.inc}
{----------------------------------------------------------------------------}
BEGIN { binaere_baeume }
@SFP := @SFP-4096+128; { Stack auf 4096 Bytes setzen fuer Pascal MT+ }
ClrScr;
GotoXY (1, 19); Write ('*** binaere Baeume: ');
Write ('(+) einfuegen, (-) loeschen, (?) suchen, (#) beenden');
baum := nil; { Anfangs ist der Baum leer. }
REPEAT
GotoXY (1, 23); Write ('Befehl: ');
GotoXY (9, 23); GetChar (befehl);
IF befehl IN ['+', '-', '?'] THEN
GetChar(stichwort);
CASE befehl OF
'+': einfuegen (baum, stichwort{, dummy}); { dummy bei AVL }
'-': loeschen (baum, stichwort{, dummy}); { dummy bei AVL }
'?': suchen (baum, stichwort);
END;
IF befehl IN ['+', '-'] THEN
BEGIN
ClrLines (1, 18);
IF baum <> nil THEN
schr_baum (baum, 1, 40, 1);
GotoXY (1, 20);
Write ('Preorder: ');
preorder (baum);
WriteLn (Chr (dc2));
Write ('Inorder: ');
inorder (baum);
WriteLn (Chr (dc2));
Write ('Postorder: ');
postorder (baum);
WriteLn (Chr (dc2));
END;
UNTIL befehl = '#';
END.
{==================== ENDE DES PROGRAMMS BINAERE BAEUME =====================}