Дерево,прямой обход,кол-во ярусов.

type
 TNext=^tree;  {указатель на дерево}
 tree=record   {запись дерева}
  count:integer; информация в дереве числа
  left:TNext;   левое поддерево
  right:TNext;  правое поддерево
 end;
 
procedure fill (n,a:integer; var root:TNext);   процедура заполнения дерева 
 var p:TNext;               n-кол-во эл-ов, root-корень дерева
 Begin
  If (a<=ln(n)/ln(2)) then  сравниваем число с лог 5 по основанию 2
   If (root^.left=nil) then проверяем пусто ли левое поддерево
    begin
     new(p);    создаем указатель
     p^.count:=a;   записываем в корент число
     p^.left:=nil;  левое поддерево делам пустым
     p^.right:=nil; правое поддерево делаем пустым
     root^.left:=p; новый указатель на корень
    end
   else fill(n,a,root^.left)     вызывам рекурсивно процедуру
  else
   If (root^.right=nil) then    проверяем пусто ли правое поддерево и делам все                             аналогично
    begin
     new(p);
     p^.count:=a;
     p^.left:=nil;
     p^.right:=nil;
     root^.right:=p;
    end
   else fill(n,a,root^.right);
 End;
 
procedure pre(p:TNext);     процедура прямого обхода где к это ярусы
var k,k1:integer;
 Begin
  If p^.left<>nil then begin k:=k+1; pre(p^.left); end;
  If p^.right<>nil then begin k1:=k1+1; pre(p^.right); end;
 writeln(k,k1);
 End;
 
const n=5;  предположительное кол-во эл-ов
var M array[1..n] of integer;   задаем все переменные
    top:TNext;i:integer;
 
Begin
 Writeln('write elements'); 
 For i:=1 to n do   пользователь вводит числа записывающиеся в массив
  read(M[i]);
 
 top^.left=nil;     правое и левое поддеревья делаем пустыми
 top^.right=nil;
 
 For i:=1 to n do   проходим по массиву 
  fill(n,M[i],top); процедура заполнения дерева
 
 pre(top);  делаем обход
 Readln
End.