Implementation

Procedure InitTree;

Begin

t:=nil;

error:=ok;

End;

Procedure PutTree;

var t1,t2:tree;

Begin

if sizeof(element)<maxavail then

if t=nil then

begin

new(t); h:=true; t^.key:=k; t^.data:=e;

t^.lson:=nil; t^.rson:=nil; t^.bal:=0;

error:=ok;

end

else if k<t^.key then

begin

PutTree(t^.lson,e,k,h);

if h then {выросла левая ветвь}

case t^.bal of

1: begin t^.bal:=0; h:=false; end;

0: t^.bal:=-1;

-1: begin {балансировка}

t1:=t^.lson;

if t1^.bal=-1 then {простой LL-поворот}

begin

t^.lson:=t1^.rson;

t1^.rson:=t;

t^.bal:=0;

t:=t1

end

else {двойной LR-поворот}

begin

t2:=t1^.rson;

t^.rson:=t2^.lson;

t2^.lson:=t1;

t^.lson:=t2^.rson;

t2^.rson:=t;

if t2^.bal=-1 then t^.bal:=1 else t^.bal:=0;

if t2^.bal=1 then t1^.bal:=-1 else t1^.bal:=0;

t:=t2

end;

t^.bal:=0; h:=false

end

end;

end

else if k>t^.key then

begin

PutTree(t^.rson,e,k,h);

if h then {выросла правая ветвь}

case t^.bal of

-1: begin t^.bal:=0; h:=false; end;

0: t^.bal:=1;

1: begin {балансировка}

t1:=t^.rson;

if t1^.bal=1 then {простой RR-поворот}

begin

t^.rson:=t1^.lson;

t1^.lson:=t;

t^.bal:=0;

t:=t1

end

else {двойной RL-поворот}

begin

t2:=t1^.lson;

t^.lson:=t2^.rson;

t2^.rson:=t1;

t^.rson:=t2^.lson;

t2^.lson:=t;

if t2^.bal=1 then t^.bal:=-1 else t^.bal:=0;

if t2^.bal=-1 then t1^.bal:=1 else t1^.bal:=0;

t:=t2

end;

t^.bal:=0; h:=false

end

end;

end

else error:=keyexist

else error:=notmem;

End;

Procedure balanceL(var t:tree; var h:boolean);

var t1,t2:tree; b1,b2:integer;

Begin {левая ветвь стала короче}

case t^.bal of

-1: t^.bal:=0;

0: begin t^.bal:=1; h:=false; end;

1: begin {балансировка}

t1:=t^.rson; b1:=t1^.bal;

if b1>=0 then {простой RR-поворот}

begin

t^.rson:=t1^.lson; t1^.lson:=t;

if b1=0 then

begin

t^.bal:=1;

t1^.bal:=-1;

h:=false

end

else

begin

t^.bal:=0;

t1^.bal:=0

end;

t:=t1

end

else {двойной RL-поворот}

begin

t2:=t1^.lson; b2:=t2^.bal;

t1^.lson:=t2^.rson; t2^.rson:=t1;

t^.rson:=t2^.lson; t2^.lson:=t;

if b2=1 then t^.bal:=-1 else t^.bal:=0;

if b2=-1 then t1^.bal:=1 else t1^.bal:=0;

t:=t2; t2^.bal:=0

end;

end

end

End;

Procedure balanceR(var t:tree; var h:boolean);

var t1,t2:tree; b1,b2:integer;

Begin {правая ветвь стала короче}

case t^.bal of

1: t^.bal:=0;

0: begin t^.bal:=-1; h:=false; end;

-1: begin {балансировка}

t1:=t^.lson; b1:=t1^.bal;

if b1<=0 then {простой LL-поворот}

begin

t^.lson:=t1^.rson; t1^.rson:=t;

if b1=0 then

begin

t^.bal:=-1;

t1^.bal:=1;

h:=false

end

else

begin

t^.bal:=0;

t1^.bal:=0

end;

t:=t1

end

else {двойной LR-поворот}

begin

t2:=t1^.rson; b2:=t2^.bal;

t1^.rson:=t2^.lson; t2^.lson:=t1;

t^.lson:=t2^.rson; t2^.rson:=t;

if b2=-1 then t^.bal:=1 else t^.bal:=0;

if b2=1 then t1^.bal:=-1 else t1^.bal:=0;

t:=t2; t2^.bal:=0

end;

end

end

End;

Procedure GetTree;

var q:tree;

Procedure Del(var r:tree; var h:boolean);

Begin

if r^.rson<>nil then

begin

Del(r^.rson,h);

if h then balanceR(r,h)

end

else

begin

q^.key:=r^.key;

q^.data:=r^.data;

q:=r; r:=r^.lson;

h:=true

end

End;{Del}

Begin

if t=nil then error:=notfound

else if k<t^.key then

begin

GetTree(t^.lson,e,k,h);

if h then balanceL(t,h)

end

else if k>t^.key then

begin

GetTree(t^.rson,e,k,h);

if h then balanceR(t,h)

end

else {исключение t^}

begin

e:=t^.data; q:=t;

error:=ok;

if (t^.rson=nil)and(t^.lson=nil) then

begin

dispose(q);

h:=true;

t:=nil

end

else if (t^.rson<>nil)and(t^.lson=nil) then

begin

t:=q^.rson;

h:=true;

dispose(q)

end

else if (t^.rson=nil)and(t^.lson<>nil) then

begin

t:=q^.lson;

h:=true;

dispose(q)

end

else

begin

Del(q^.lson,h);

dispose(q);

if h then balanceL(t,h)

end

end;

error:=ok;

End;

Function EmptyTree;

Begin

EmptyTree:=t=nil;

End;

Procedure DoneTree;

Procedure Clear(t:tree);

Begin

if t<>nil then

begin

Clear(t^.lson);

Clear(t^.rson);

Dispose(t)

end

End;{Clear}

Begin

Clear(t);

error:=ok;

End;

End.

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

Unit UObjList; {объектовый тип список}