Дана последовательность чисел. Построить бинарное дерево, содержащее эти числа.

program prg;
uses crt;
type
   ptrnode=^node; {тип - указатель на дерево
   node = record {это узел дерева, он имеет одно поле данных, для поля для ссылок (указателей) на сыновей узла}
        data: integer;
        l,r: ptrnode; {l - левый сын, r - правый сын}
   end;
procedure add(var p: ptrnode; x :integer); {процидура добавления элемента в дерево}
begin
     if p <> nil then begin {такая проверка нужна что бы не обращаться к пустой структуре}
        if x > p^.data then add(p^.r,x); {если вставляемое значние больше отца, то добавить его в правое поддерево}
        if x < p^.data then add(p^.l,x); {если вставляемое значние меньше отца, то добавить его в правое поддерево}
        if x = p^.data then writeln('This element already exist'); {если равно то такой элемнт уже есть, не бобавляем его.}
    end
    else begin {в другом случаи можно создавать структуру для ссылки}
         p:=new(ptrnode); {выделяем память в куче для структуры}
         p^.data:=x; {инициализируем её поля}
         p^.l:=nil;
         p^.r:=nil;
    end;
end;
procedure print(p: ptrnode; n: integer); {поцидура для вывода содержимого дерева на экран}
var i: integer;                                    {n - это сколько табуляцие делать}
begin
     if p <> nil then begin {сначало надо вывести правое поддерево}
        if p^.r <> nil then print(p^.r,n+1); {на одну табуляцию больше}
        for i:=1 to n do write('   '); writeln(p^.data);
        if p^.l <> nil then print(p^.l,n+1); {потом левое поддерево}
     end;
end;
 
procedure del(var p: ptrnode); {удаление дерева, освобождение памяти от дерева}
begin
     if p <> nil then begin
        if p^.r <> nil then del(p^.r); {удалить правое поддерево}
        if p^.l <> nil then del(p^.l); {удалить левое поддерево}
        dispose(p); {удалить сам элемент}
     end;
end;
 
var
   root: ptrnode;
begin
     clrscr;
     root:=nil;
     {сначала довбавим в дерево несколько элементов, можно болше, можно в цикле}
     add(root,4);
     add(root,7);
     add(root,3);
     add(root,6);
     print(root,0); {выведем дерево на экран}
     readln;
     del(root); {удалим дерево, осовбодим память}
end.

program prg;
uses crt;
type
   ptrnode=^node;
   node = record
        data: integer;
        l,r: ptrnode;
   end;
procedure add(var p: ptrnode; x :integer);
begin
     if p <> nil then begin
        if x > p^.data then add(p^.r,x);
        if x < p^.data then add(p^.l,x);
        if x = p^.data then writeln('This element already exist');
    end
    else begin
         p:=new(ptrnode);
         p^.data:=x;
         p^.l:=nil;
         p^.r:=nil;
    end;
end;
procedure print(p: ptrnode; n: integer);
var i: integer;
begin
     if p <> nil then begin
        if p^.r <> nil then print(p^.r,n+1);
        for i:=1 to n do write('   '); writeln(p^.data);
        if p^.l <> nil then print(p^.l,n+1);
     end;
end;
 
procedure del(var p: ptrnode);
begin
     if p <> nil then begin
        if p^.r <> nil then del(p^.r);
        if p^.l <> nil then del(p^.l);
        dispose(p);
     end;
end;
 
function depth(p: ptrnode): integer; {вычисляет глубину дерева}
var dr,dl: integer;
begin
     if p <> nil then begin
        if (p^.r <> nil) then dr:=depth(p^.r)+1;
        if (p^.l <> nil) then dl:=depth(p^.l)+1;
     end;
     if dr > dl then  depth:=dr else depth:=dl;
end;
 
procedure step(p: ptrnode;lavel,stop: integer); {эта поцидура распечатывает все узлы уровня stop}
begin
     if p <> nil then begin
        if lavel=stop then writeln(p^.data);
        if (p^.r <> nil) then step(p^.r,lavel+1,stop);
        if (p^.l <> nil) then step(p^.l,lavel+1,stop);
     end;
end;
 
var
   root: ptrnode;
   var i: integer;
begin
     clrscr;
     root:=nil;
     add(root,5);
     add(root,2);
     add(root,8);
     add(root,4);
     add(root,1);
     add(root,6);
     add(root,9);
     print(root,0);
     for i:=1 to depth(root) do step(root,1,i);
     readln;
     del(root);
end.