Moin,
in meinem Archiv habe ich noch eine Demo anno 1990 gefunden.
Programmiert in
TP 4
PROGRAM AVL_BAUMDEMONSTRATION;
USES CRT;
CONST MAX=3;
TYPE BAUMINHALT=STRING[MAX];
SEITE=(LEFT,NONE,RIGHT);
BAUMZEIGER=^KNOTEN;
KNOTEN=RECORD
INHALT:BAUMINHALT;
LINKS,RECHTS:BAUMZEIGER;
SCHIEFE:SEITE
END;
VAR BAUM,SBAUM:BAUMZEIGER;
EINGABE:BAUMINHALT;
AUSWAHL:CHAR;
FELD:BYTE;
ZUSTAND:BOOLEAN;
PROCEDURE AUSGABE(X:INTEGER);
BEGIN
GOTOXY(41,18);WRITE('Stichwort ');
CASE X OF
0 : WRITE('wurde nicht gefunden.');
1 : WRITE('wird eingetragen.');
2 : WRITE('wird geloescht.');
3 : WRITE('wurde gefunden.');
4 : WRITE('ist schon vorhanden')
END;
CLREOL;GOTOXY(1,24);WRITE('Weiter mit <RETURN>');READ;GOTOXY(1,24);CLREOL
END;
PROCEDURE ROT_R(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.LINKS;BAUM^.LINKS:=AST^.RECHTS;AST^.REC HTS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_L(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.RECHTS;BAUM^.RECHTS:=AST^.LINKS;AST^.LI NKS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_LR(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.LINKS;AST2:=BAUM^.RECHTS;AST1^.RECHTS: =AST2^.LINKS;
AST2^.LINKS:=AST1;BAUM^.LINKS:=AST2^.RECHTS;AST2^. RECHTS:=BAUM;
IF AST2^.SCHIEFE=LEFT THEN BAUM^.SCHIEFE:=RIGHT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=RIGHT THEN AST1^.SCHIEFE:=LEFT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE ROT_RL(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.RECHTS;AST2:=BAUM^.LINKS;AST1^.LINKS:= AST2^.RECHTS;
AST2^.RECHTS:=AST1;BAUM^.RECHTS:=AST2^.LINKS;AST2^ .LINKS:=BAUM;
IF AST2^.SCHIEFE=RIGHT THEN BAUM^.SCHIEFE:=LEFT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=LEFT THEN AST1^.SCHIEFE:=RIGHT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE EINFUEGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
PROCEDURE ERZEUGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
NEW(BAUM);GEWACHSEN:=TRUE;BAUM^.INHALT:=STICHWORT; AUSGABE(1);
WITH BAUM^ DO BEGIN LINKS:=NIL;RECHTS:=NIL;SCHIEFE:=NONE END
END;
PROCEDURE WEITER_LINKS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.LINKS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END;
NONE : BAUM^.SCHIEFE:=LEFT;
LEFT : BEGIN
IF BAUM^.LINKS^.SCHIEFE=LEFT THEN
BEGIN ROT_R(BAUM);BAUM^.RECHTS^.SCHIEFE:=NONE END
ELSE ROT_LR(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END
END
END;
PROCEDURE WEITER_RECHTS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.RECHTS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN
IF BAUM^.RECHTS^.SCHIEFE=RIGHT THEN
BEGIN ROT_L(BAUM);BAUM^.LINKS^.SCHIEFE:=NONE END
ELSE ROT_RL(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END;
NONE : BAUM^.SCHIEFE:=RIGHT;
LEFT : BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END
END
END;
BEGIN(* OF EINFUEGEN *)
IF BAUM=NIL THEN ERZEUGEN(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT>STICHWORT THEN WEITER_LINKS(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT<STICHWORT THEN WEITER_RECHTS(BAUM,STICHWORT,GEWACHSEN)
ELSE BEGIN AUSGABE(4);GEWACHSEN:=FALSE END (* SCHON VORHANDEN *)
END;(* OF EINFUEGEN *)
PROCEDURE LOESCHEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GESCHRUMPFT:BOOLEAN);
VAR KNOTEN:BAUMZEIGER;
PROCEDURE AUSGL_RECHTS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
LEFT : CASE BAUM^.LINKS^.SCHIEFE OF
LEFT : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.RECHTS^.SCHI EFE:=NONE
END;
NONE : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=RIGHT;BAUM^.RECHTS^.SCH IEFE:=LEFT;
GESCHRUMPFT:=FALSE
END;
RIGHT: BEGIN ROT_LR(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=LEFT;GESCHRUMPFT:=FALSE END;
RIGHT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE AUSGL_LINKS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
RIGHT : CASE BAUM^.RECHTS^.SCHIEFE OF
RIGHT : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.LINKS^.SCHIE FE:=NONE
END;
NONE : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=LEFT;BAUM^.LINKS^.SCHIE FE:=RIGHT;
GESCHRUMPFT:=FALSE
END;
LEFT: BEGIN ROT_RL(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=RIGHT;GESCHRUMPFT:=FALSE END;
LEFT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE KLEINSTEN_HOLEN(VAR ZWEIG:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
IF ZWEIG^.LINKS=NIL THEN
BEGIN
BAUM^.INHALT:=ZWEIG^.INHALT;KNOTEN:=ZWEIG;ZWEIG:=Z WEIG^.RECHTS;
GESCHRUMPFT:=TRUE
END
ELSE BEGIN
KLEINSTEN_HOLEN(ZWEIG^.LINKS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(ZWEIG,GESCHRUMPFT)
END
END;
PROCEDURE ENTFERNEN(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
KNOTEN:=BAUM;
IF BAUM^.RECHTS=NIL THEN BEGIN BAUM:=BAUM^.LINKS;GESCHRUMPFT:=TRUE END
ELSE IF BAUM^.LINKS=NIL THEN BEGIN BAUM:=BAUM^.RECHTS;GESCHRUMPFT:=TRUE END
ELSE BEGIN
KLEINSTEN_HOLEN(BAUM^.RECHTS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END;
DISPOSE(KNOTEN)
END;
BEGIN(* OF LOESCHEN *)
IF BAUM=NIL THEN BEGIN AUSGABE(0);GESCHRUMPFT:=FALSE END (* NICHT VORHANDEN *)
ELSE IF BAUM^.INHALT>STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.LINKS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(BAUM,GESCHRUMPFT)
END
ELSE IF BAUM^.INHALT<STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.RECHTS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END
ELSE BEGIN AUSGABE(2);ENTFERNEN(BAUM,GESCHRUMPFT) END (* WIRD GELOESCHT *)
END;(* OF LOESCHEN *)
PROCEDURE SUCHEN(TREE:BAUMZEIGER;VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT);
BEGIN
BAUM:=TREE;
IF BAUM=NIL THEN AUSGABE(0)
ELSE IF BAUM^.INHALT>STICHWORT THEN SUCHEN(BAUM^.LINKS,BAUM,STICHWORT)
ELSE IF BAUM^.INHALT<STICHWORT THEN SUCHEN(BAUM^.RECHTS,BAUM,STICHWORT)
ELSE AUSGABE(3)
END;
PROCEDURE LINIE(VON,BIS,ZEILE:INTEGER);
VAR I:INTEGER;
BEGIN
IF VON<BIS THEN FOR I:=VON TO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END
ELSE FOR I:=VON DOWNTO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END;
GOTOXY(BIS,ZEILE+1);WRITE('I')
END;
PROCEDURE KOPF;
BEGIN
CLRSCR;
WRITELN('Demonstration eines AVL-Baumes':58);
WRITELN('------------------------------':58)
END;
PROCEDURE SCHREIBBAUM(B:BAUMZEIGER;X,Y,BREITE:INTEGER);
VAR H:BYTE;
BEGIN
IF B<>NIL THEN
BEGIN
IF B^.LINKS<>NIL THEN BEGIN
LINIE(X-FELD+1,X-BREITE DIV 2,Y);
SCHREIBBAUM(B^.LINKS,X-BREITE DIV 2,Y+2,BREITE DIV 2)
END;
GOTOXY(X-FELD DIV 2,Y);WRITE(COPY(B^.INHALT,1,FELD));
IF B^.RECHTS<>NIL THEN BEGIN
H:=0;IF FELD=1 THEN H:=1;
LINIE(X+FELD-1+H,X+BREITE DIV 2,Y);
SCHREIBBAUM(B^.RECHTS,X+BREITE DIV 2,Y+2,BREITE DIV 2)
END
END
END;
PROCEDURE PREORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
WRITE(B^.INHALT:FELD+1);PREORDER(B^.LINKS);PREORDE R(B^.RECHTS)
END
END;
PROCEDURE INORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
INORDER(B^.LINKS);WRITE(B^.INHALT:FELD+1);INORDER( B^.RECHTS)
END
END;
PROCEDURE POSTORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
POSTORDER(B^.LINKS);POSTORDER(B^.RECHTS);WRITE(B^. INHALT:FELD+1)
END
END;
BEGIN(* OF MAIN *)
CLRSCR;
REPEAT
WRITE('MAXIMALE EINGABELAENGE (1-',MAX:1,') ? ');READLN(FELD)
UNTIL FELD IN[1..MAX];
KOPF;BAUM:=NIL;
REPEAT
GOTOXY(1,23);CLREOL;GOTOXY(1,23);
WRITE('(E)infgen (L)”schen (S)uchen (Q)uit : ');CLREOL;
REPEAT
AUSWAHL:=UPCASE(READKEY)
UNTIL AUSWAHL IN['E','L','S','Q'];WRITELN(AUSWAHL);
IF AUSWAHL<>'Q' THEN
BEGIN
REPEAT
GOTOXY(1,24);CLREOL;GOTOXY(1,24);
WRITE('Dein Begriff : ');READLN(EINGABE)
UNTIL LENGTH(EINGABE)>0;
EINGABE:=COPY(EINGABE,1,FELD);
CASE AUSWAHL OF
'E': BEGIN EINFUEGEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(B AUM,40,5,40) END;
'L': BEGIN LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BA UM,40,5,40) END;
'S': BEGIN
SUCHEN(BAUM,SBAUM,EINGABE);KOPF;
IF SBAUM<>NIL THEN SCHREIBBAUM(SBAUM,40,5,40)
END
END;
GOTOXY(20,24);WRITE('Weiter mit <ENTER>');READLN;GOTOXY(1,24);CLREOL;
SCHREIBBAUM(BAUM,40,5,40);
GOTOXY(1,16);WRITE('Preorder :');PREORDER(BAUM);
GOTOXY(1,18);WRITE('Inorder :');INORDER(BAUM);
GOTOXY(1,20);WRITE('Postorder :');POSTORDER(BAUM)
END
UNTIL AUSWAHL='Q'
END.
Gruß Fiete