Проверка дерева на сбалансированность

[dr.Jekill]

Ни у кого нет процедурки проверки дерева на сблансированность?
Есть наработки, но нужно проверять высоту двух его поддеревьев для каждого узла.
[syntax=pascal]
uses Crt;
type TreePointer=^tree;
tree = record
data: integer;
left: TreePointer;
right: TreePointer;
end;
var root, dummy: TreePointer;
ch,n,kol_l,kol_r,i:integer;

procedure InsIteration(Var T : TreePointer; X : integer);
Var vsp, A :TreePointer;
Begin
New(A);
A^.data:=X;
A^.Left:=Nil;
A^.Right:= Nil;
If T=Nil Then T:=A
Else
Begin
vsp := T;
While vsp <> Nil Do
If A^.data< vsp^.data Then
If vsp^.Left=Nil Then
Begin
vsp^.Left:=A;
vsp:=A^.Left;
inc(kol_l)
End
Else vsp:=vsp^.Left
Else If vsp^.Right = Nil Then
Begin
vsp^.Right := A;
vsp:=A^.Right;
inc(kol_r);
End
Else vsp := vsp^.Right;
End
End;

procedure PrintTree(r: TreePointer; n: integer);
var i:integer;
begin
if r<>nil then
begin
PrintTree(r^.left, n+1);
for i := 1 to n do Write(' ');
Writeln(r^.data);
PrintTree(r^.right, n+1);
end;
end;

begin
clrscr;
kol_l:=0;
kol_r:=0;
root:=nil;
write('Vvedite kol-vo: ');
readln(n);
i:=0;
repeat
inc(i);
Write('Vvedite element #',i,': ');
readln(ch);
InsIteration(root,ch);
until i=n;
clrscr;
PrintTree(root, 0);
readkey;
clrscr;
if (abs(kol_l-kol_r)=0) or (abs(kol_l-kol_r)=1) then writeln('Derevo sbalansirovano.')
else
begin
write('Derevo NE sbalansirovano');
if (kol_l=n-1) or (kol_r=n-1) then write(', i vyrozhdeno.')
else write('.');
end;
readkey;
end.
[/syntax]

[Naeel Maqsudov]

У Д.Кнута в "Искусстве программирования" что-то было в первом томе.

[dr.Jekill]

Спасибо,Naeel. Но нет ничего поконкретней? Конечно спасибо и за это - посмотрю.