unit AVLUnit;
interface
type wsk = ^wezel;
wezel = record
klucz: integer;
lewe, prawe: wsk;
wywaz: -1..+1;
end;
procedure wstawianie(x:integer; var p: wsk; var h: boolean);
procedure usuwanie(x:integer; var p:wsk; var h:boolean);
procedure rotacjawprawo(var p:wsk; var h:boolean);
procedure rotacjawlewo(var p:wsk; var h:boolean);
procedure usun (var r:wsk; var t:wsk; var h:boolean);
procedure drukujAVL (T:wsk; n:integer);
implementation
procedure wstawianie(x:integer; var p: wsk; var h: boolean);
var p1,p2: wsk;
BEGIN
if p=NIL then
begin
new(p);
h:=true;
p^.klucz:=x;
p^.lewe:=NIL;
p^.prawe:=NIL;
p^.wywaz:=0;
end
else
if x begin wstawianie(x, p^.lewe, h); if h then case p^.wywaz of 1: begin p^.wywaz:=0; h:=false; end; 0: p^.wywaz:=-1; -1: begin p1:=p^.lewe; if p1^.wywaz=-1 then begin {pojedyncza rotacja w lewo} p^.lewe:=p1^.prawe; p1^.prawe:=p; p^.wywaz:=0; p:=p1; end else begin {podwojna rotacja w lewo} p2:=p1^.prawe; p1^.prawe:=p2^.lewe; p2^.lewe:=p1; p^.lewe:=p2^.prawe; p2^.prawe:=p; if p2^.wywaz=-1 then p^.wywaz:=1 else p^.wywaz:=0; if p2^.wywaz=1 then p1^.wywaz:=-1 else p1^.wywaz:=0; p:=p2; end; p^.wywaz:=0; h:=false; end; end; end else if x>p^.klucz then begin wstawianie(x, p^.prawe, h); if h then case p^.wywaz of -1: begin p^.wywaz:=0; h:=false; end; 0: p^.wywaz:=1; 1: begin p1:=p^.prawe; if p1^.wywaz=1 then begin {pojedyncza rotacja w prawo} p^.prawe:=p1^.lewe; p1^.lewe:=p; p^.wywaz:=0; p:=p1; end else begin {podwojna rotacja w prawo} p2:=p1^.lewe; p1^.lewe:=p2^.prawe; p2^.prawe:=p1; p^.prawe:=p2^.lewe; p2^.lewe:=p; if p2^.wywaz=1 then p^.wywaz:=-1 else p^.wywaz:=0; if p2^.wywaz=-1 then p1^.wywaz:=1 else p1^.wywaz:=0; p:=p2; end; p^.wywaz:=0; h:=false; end; end; end else begin Writeln('*** ODNALEZIONO ***'); Writeln('*** KLUCZ ***'); h:=false; end; END; procedure rotacjawprawo(var p:wsk; var h:boolean); var p1,p2:wsk; BEGIN case p^.wywaz of -1:p^.wywaz:=0; 0:begin p^.wywaz:=1; h:=false; end; 1:begin p1:=p^.prawe; if p^.wywaz>=0 then {pojedyncza rotacja} begin p^.prawe:=p1^.lewe; p1^.lewe:=p; if p^.wywaz = 0 then begin p^.wywaz:=1; p1^.wywaz:=-1; h:=false; end else begin p^.wywaz:=0; p1^.wywaz:=0; end; p:=p1; end else {podwojna rotacja} begin p2:=p1^.lewe; p1^.lewe:=p2^.prawe; p2^.prawe:=p1; p^.prawe:=p2^.lewe; p2^.lewe:=p; if p2^.wywaz=1 then p^.wywaz:=-1 else p^.wywaz:=0; if p2^.wywaz=-1 then p^.wywaz:=1 else p^.wywaz:=0; p:=p2; p2^.wywaz:=0; end; end; end; END; procedure rotacjawlewo(var p:wsk; var h:boolean); var p1,p2:wsk; BEGIN case p^.wywaz of 1:p^.wywaz:=0; 0:begin p^.wywaz:=-1; h:=false; end; -1:begin p1:=p^.lewe; if p1^.wywaz<=0 then {pojedyncza rotacja} begin p^.lewe:=p1^.prawe; p1^.prawe:=p; if p1^.wywaz = 0 then begin p^.wywaz:=-1; p1^.wywaz:=1; h:=false; end else begin p^.wywaz:=0; p1^.wywaz:=0; end; p:=p1; end else {podwojna rotacja} begin p2:=p1^.prawe; p1^.prawe:=p2^.lewe; p2^.lewe:=p1; p^.lewe:=p2^.prawe; p2^.prawe:=p; if p2^.wywaz=1 then p^.wywaz:=-1 else p^.wywaz:=0; if p2^.wywaz=-1 then p^.wywaz:=1 else p^.wywaz:=0; p:=p2; p2^.wywaz:=0; end; end; end; END; procedure usun (var r:wsk; var t:wsk; var h:boolean); BEGIN if r^.prawe<>NIL then begin usun(r^.prawe,t,h); if h then rotacjawlewo(r,h); end else begin t^.klucz:=r^.klucz; r:=r^.lewe; h:=true; end; END; procedure usuwanie(x:integer; var p:wsk; var h:boolean); var q,r: wsk; BEGIN if p=NIL then begin {brak klucza w drzewie} Writeln('*** BRAK KLUCZA ***'); h:=false; end else if x begin usuwanie(x,p^.lewe,h); if h then rotacjawprawo(p,h); end else if x>p^.klucz then begin usuwanie(x,p^.prawe,h); if h then rotacjawlewo(p,h); end else begin q:=p; if q^.prawe = NIL then begin p:=q^.lewe; h:=true; end else if q^.lewe = NIL then begin p:=q^.prawe; h:=true; end else begin usun(q^.lewe, q, h); if h then rotacjawprawo(p,h); end; {dispose(q);} end; END; procedure drukujAVL (T:wsk; n:integer); var i: integer; begin if T<>NIL then begin drukujAVL (T^.prawe, n+1); for i:=1 to n do Write(' '); Writeln(T^.klucz); drukujAVL (T^.lewe, n+1); end; end; END. ************************************************************************ unit BSTUnit; interface type ptr = ^wezelek; wezelek = record klucz: integer; lewe, prawe: ptr; end; procedure drukujBST(w: ptr; n:integer); procedure przeszukanie (x: integer; var p: ptr); procedure wyrzucenie(x:integer; var p: ptr); implementation procedure drukujBST(w: ptr; n:integer); var i:integer; begin if w<>NIL then begin drukujBST(w^.lewe, n+1); for i:=1 to n do Write(' '); Writeln(w^.klucz); drukujBST(w^.prawe, n+1); end; end; procedure wyrzucenie(x:integer; var p: ptr); var q: ptr; procedure us(var r:ptr); begin if r^.prawe<>NIL then us(r^.prawe) else begin q^.klucz:=r^.klucz; q:=r; r:=r^.lewe; end; end; begin {wyrzuceniue} if p= NIL then Writeln('### BRAK KLUCZA ###') else if x if x>p^.klucz then wyrzucenie(x,p^.prawe) else begin q:=p; if q^.prawe = NIL then p:=q^.lewe else if q^.lewe = NIL then p:=q^.prawe else us(q^.lewe); end; end; procedure przeszukanie (x: integer; var p: ptr); begin if p=NIL then begin new (p); p^.klucz:=x; p^.lewe:=NIL; p^.prawe:=NIL; end else if x if x>p^.klucz then przeszukanie(x,p^.prawe) else begin Writeln('### ODNALEZIONO ###'); Writeln('### KLUCZ ###'); end; end; END. ************************************************************************ program drzewaAVLBST; uses crt, AVLUnit, BSTUnit; var p:wsk; t:ptr; z: Integer; {*******************DRUKOWANIE **********************} procedure PrintAVL; begin window(5,14,26,24); TextBackground(Magenta); TextColor(Yellow); ClrScr; Writeln('Twoje drzewo AVL: '); drukujAVL(p,0); end; procedure PrintBST; begin window (27,14,60,24); TextBackground(Magenta); TextColor(Green); ClrScr; Writeln('Twoje drzewo BST:'); drukujBST(t,0); end; {********************WSTAWIANIE *********************} procedure Insert(i:integer); var x:integer; h:boolean; begin Writeln('Podaj wartosc wag:'); Readln(x); case i of 1:begin wstawianie(x,p,h); Readln; ClrScr; PrintAVL; end; 2:begin przeszukanie(x,t); Readln; ClrScr; PrintBST; end; end; end; {***********************USUWANIE************************} procedure Delete(i:integer); var x:integer; h:boolean; begin Writeln('Element do usuniecia:'); Readln(x); case i of 1:begin usuwanie(x,p,h); Readln; ClrScr; PrintAvl; end; 2:begin wyrzucenie(x,t); Readln; ClrScr; PrintBST; end; end; end; procedure menu; begin Writeln ("DRZEWA AVL I BST"); Writeln ("1. Wstaw/wyszukaj w drzewie AVL"); Writeln ("2. Usun z drzewa AVL"); Writeln ("3. Wstaw/wyszukaj w drzewie BST"); Writeln ("4. Usun z drzewa BST"); Writeln ("5. Wyjscie"); end; BEGIN menu; readln (z); while z<5 do begin menu; case z of 1: Insert(1); 2: Delete(1); 3: Insert(2); 4: Delete(2); end; readln(z); end; END.
