# balanced binary trees

Balanced binary trees are extremely efficient datastructures for searching data.
Finding an element in 65536 requires at most 16 compares.
```//
//  Taken from Nicklaus Wirth :
//    Algorithmen und Datenstrukturen ( in Pascal )
//    Balanced Binary Trees p 250 ++
//
//   for Turbo Pascal
//   not usable as it is in Delphi !!
//
//
//
//
unit BTree;

interface

type
ref=^node;
node=record
key:integer;  // the data associated with the node
left,right:ref;
bal:-1..1;
count:byte;
end;

implementation

procedure search(x:integer;var p:ref;var h:boolean);   // insert
var p1,p2:ref; // h=false
begin
if p=nil then
begin        // word not in tree, insert it
new(p); h:=true;
with p^ do
begin
key:=x;  count:=1;
left:=nil; right:=nil; bal:=0;
end;
end
else
if (xp^.key) then
begin
search(x,p^.right,h);
if h then  // right branch got bigger
case p^.bal of
-1:begin
p^.bal:=0; h:=false;
end;
0: p^.bal:=+1;
+1:begin    // new balancing
p1:=p^.right;
if p1^.bal=+1 then
begin  // single rr rotation
p^.right:=p1^.left; p1^.left:=p;
p^.bal:=0; p:=p1;
end
else
begin  // double rl rotation
p2:=p1^.left;
p1^.left:=p2^.right;
p2^.right:=p1;
p^.right:=p2^.left;
p2^.left:=p;
if p2^.bal=+1 then p^.bal:=-1 else p^.bal:=0;
if p2^.bal=-1 then p1^.bal:=+1 else p1^.bal:=0;
p:=p2;
end;
p^.bal:=0; h:=false;
end;
end; // case
end
else
begin
p^.count:=p^.count+1;
h:=false;
end;
end; //search

procedure delete(x:integer;var p:ref;var h:boolean);
var q:ref; //h=false;

procedure balance1(var p:ref;var h:boolean);
var p1,p2:ref; b1,b2:byte;
begin    //h=true left branch got smaller
case p^.bal of
-1: p^.bal:=0;
0: begin
p^.bal:=+1;h:=false;
end;
+1: begin // new balance
p1:=p^.right;b1:=p1^.bal;
if b1>=0 then
begin    // simple rr rotation
p^.right:=p1^.left; p1^.left:=p;
if b1=0 then
begin
p^.bal:=+1; p1^.bal:=-1; h:=false;
end
else
begin
p^.bal:=0; p1^.bal:=0;
end;
p:=p1;
end
else
begin   // double rl rotation
p2:=p1^.left; b2:=p2^.bal;
p1^.left:=p2^.right; p2^.right:=p1;
p^.right:=p2^.left; p2^.left:=p;
if b2=+1 then p^.bal:=-1 else p^.bal:=0;
if b2=-1 then p1^.bal:=+1 else p1^.bal:=0;
p:=p2;p2^.bal:=0;
end;
end; { +1}
end; { case }
end; { bal1 }

procedure balance2(var p:ref;var h:boolean);
var p1,p2:ref;b1,b2:byte;
begin     //h=true right branch got smaller
case p^.bal of
-1: p^.bal:=0;
0: begin
p^.bal:=-1;h:=false;
end;
+1: begin // new balance
p1:=p^.left;b1:=p1^.bal;
if b1<=0 then
begin    // simple ll rotation
p^.left:=p1^.right; p1^.right:=p;
if b1=0 then
begin
p^.bal:=-1; p1^.bal:=+1; h:=false;
end
else
begin
p^.bal:=0; p1^.bal:=0;
end;
p:=p1;
end
else
begin   // double lr rotation
p2:=p1^.right; b2:=p2^.bal;
p1^.right:=p2^.left; p2^.left:=p1;
p^.left:=p2^.right; p2^.right:=p;
if b2=-1 then p^.bal:=+1 else p^.bal:=0;
if b2=+1 then p1^.bal:=-1 else p1^.bal:=0;
p:=p2;p2^.bal:=0;
end;
end; { +1}
end; { case }
end; { bal2 }

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
q^.key:=r^.key;
q^.count:=r^.count;
q:=r;
r:=r^.left;h:=true;
end;
end;

begin { main of delete }
if (p=nil) then
begin
writeln('key not in tree');h:=false;
end
else
if (xp^.key)then
begin
delete(x,p^.right,h);
if h then balance2(p,h);
end
else
begin // remove q
q:=p;
if q^.right=nil then
begin
p:=q^.left;h:=true;
end
else
if (q^.left=nil) then
begin
p:=q^.right;h:=true;
end
else
begin
del(q^.left,h);
if h then balance1(p,h);
end;
dispose(q);
end;
end; { delete }

end.

```

home

last updated: 26.jan.00