procedure delete(x:integer; var q:ref; var h:boolean);
var p:ref; {h=false}
procedure balance1(var q:ref; var h:boolean);
var q1,q2:ref;
b1,b2:-1..1;
begin {h -true, левая ветвь стала короче}
case q^.bal of
-1: q^.bal:=0;
0: begin
q^.bal:=1;
h:=false;
end;
1: begin {balance}
q1:=q^.right;
b1:=q1^.bal;
if b1>=0 then
begin {однократный RR-поворот}
q^.right:=q1^.left;
q1^.left:=q;
if b1=0 then
begin
q^.bal:=1;
q1^.bal:=-1;
h:=false;
end else begin
q^.bal:=0;
q1^.bal:=0;
end;
q:=q1;
end else
begin {двукратный RL- поворот}
q2:=q1^.left;
b2:=q2^.bal;
q1^.left:=q2^.right;
q2^.right:=q1;
q^.right:=q2^.left;
q2^.left:=q;
if b2=1 then q^.bal:=-1 else q^.bal:=0;
if b2=-1 then q1^.bal:=1 else q1^.bal:=0;
q:=q2;
q2^.bal:=0;
end
end
end
end; {balance1}
procedure balance2(var q:ref; var h:boolean);
var q1,q2:ref;
b1,b2:-1..1;
begin {h -true, правая ветвь стала короче}
case q^.bal of
1: q^.bal:=0;
0: begin
q^.bal:=-1;
h:=false;
end;
-1: begin {balance}
q1:=q^.left;
b1:=q1^.bal;
if b1<=0 then
begin {однократный LL- поворот}
q^.left:=q1^.right;
q1^.right:=q;
if b1=0 then
begin
q^.bal:=-1;
q1^.bal:=1;
h:=false;
end else begin
q^.bal:=0;
q1^.bal:=0;
end;
q:=q1;
end else
begin {двукратный LR- поворот}
q2:=q1^.right;
b2:=q2^.bal;
q1^.right:=q2^.left;
q2^.left:=q1;
q^.left:=q2^.right;
q2^.right:=q;
if b2=-1 then q^.bal:=1 else q^.bal:=0;
if b2=1 then q1^.bal:=-1 else q1^.bal:=0;
q:=q2;
q2^.bal:=0;
end
end
end
end; {balance2}
procedure del(var r:ref; var h;boolean);
begin {h=false}
if r^.right<> nil then begin
del(r^.right,h);
if h then balance2(r,h)
end else
begin
p^.inf:=r^.inf;
p^.count:=r^.count;
r:=r^.left;
h:=true;
end
end;
BEGIN {delete}
if q=nil then begin
writeln("sym is not in tree");
h:=false;
end else
if x delete(x,q^.left,h);
if h then balance1(q,h)
end else
if x>q^.inf then begin
delete(x,q^.right,h);
if h then balance2(q,h)
end else
begin {удаление q^}
p:=q;
if p^.right=nil then begin
q:=p^.left;
h:=true;
end else
if p^.left=nil then begin
q:=p^.right;
h:=true;
end else
begin
del(q^.left,h);
if h then balance1(p,h);
end;
{dispose(p);}
end
end; {delete}
Переменная h — логический параметр, означает, что высота поддерева уменьшилась. Значение true присваивается h при нахождении и удалении узла или если сама балансировка уменьшает высоту поддерева. В программе две процедуры балансировки balance1 и balance2. Первая процедура используется, когда уменьшается высота левого поддерева, вторая — правого.