procedure checkrots( var t : tree );
{*** check need for rotations ***}
var wl, wll, wr, wrr : integer;
begin
if t <> nil then with t^ do begin
wl := wt( left );
wr := wt( right );
if wr > wl then begin
{*** left rotation needed ***}
wrr := wt( right^.right );
if (wrr > wl) and (2*wrr >= wr) then
begin lrot( t ); checkrots( left ) end
else if wr-wrr > wl then begin
rrot( right ); lrot( t );
Rots := Rots-1;
checkrots( left ); checkrots( right )
end
end
else if wl > wr then begin
{*** right rotation needed ***}
wll := wt( left^.left );
if (wll > wr) and (2*wll >= wl) then
begin rrot( t ); checkrots( right ) end
else if wl-wll > wr then begin
lrot( left ); rrot( t );
Rots := Rots-1;
checkrots( left ); checkrots( right )
end
end
end
end;
procedure insert( key : typekey; var t : tree );
begin
if t = nil then begin
t := NewNode( key, nil, nil );
t^.weight := 2
end
else if t^.k = key then
i:=i-1
else with t^ do begin
if k < key then insert( key, right )
else insert( key, left );
weight := wt( left ) + wt( right );
checkrots( t )
end
end;
|