uses crt;
 const A=3;D=3;

 type data = word;
      TpNode = ^TNOde;
      TNode = record
              inf: data;
              count: word;
              Left,Right: TpNode;
      end;
 var pRoot: TpNode;
     pParent,pCurrent: TpNode;
     tmp: data;
     ot:char;
     count: word;



procedure FindNode(x: data);
var stop: boolean;
begin
pCurrent := pRoot;
Stop := false;
While  (pCurrent <> nil)  and  (not  Stop)  do
     if  x < pCurrent ^.inf   then   pCurrent := pCurrent^.left  else
         if  x > pCurrent ^.inf  then   pCurrent := pCurrent^.right  else  Stop := true;
if pCurrent <> nil then
write('Node: ',pCurrent^.inf,'(',pCurrent^.count,')')
else write('No such node!');
readln;
end;


Procedure AddNode1(var pCurrent: TpNode;x: data);
begin
     if  pCurrent = nil  then
     begin
          New ( pCurrent );
          pCurrent^.inf := x;
          pCurrent^.left := nil;   pCurrent^.right := nil;
          pCurrent^.count := 1;
          if pRoot = nil then pRoot := pCurrent;
     end
     else
          if   x < pCurrent^.inf   then  AddNode1(pCurrent^.left,x)
             else   if   x > pCurrent^.inf   then  AddNode1(pCurrent^.right,x)
                     else  Inc(pCurrent^.count);
end;

procedure create;
var n,i: word;
begin
clrscr;
write('Type N: '); readln(n);
if n <> 0 then
   for i := 1 to n do addNode1(pRoot,random(100));
end;

Procedure AddNode2(x: data);
begin
if  pRoot = nil  then
   begin
      New (pRoot);   pRoot^.left := nil;  pRoot^.right := nil;
      pRoot^.inf := x; pRoot^.count := 1;
   end
else
   begin
      pCurrent := pRoot;       {начинаем поиск с корня дерева}
      while  (pCurrent <> nil )  do
      begin
         pParent := pCurrent;     {запоминаем адрес родительской вершины}
         if  ( x < pCurrent^.inf) then  pCurrent := pCurrent^.left
             else  if  ( x > pCurrent^.inf)  then  pCurrent := pCurrent^.right
                 else  begin     {вершина найдена, добавлять не надо, закончить цикл}
                            pCurrent := nil;
                            Inc(pParent^.count);
                         end;
      end;
      if  ( x < pParent^.inf)  then
      begin                                  {добавляем новую вершину слева от родителя}
         New (pCurrent);
         pCurrent^.inf := x; pCurrent^.count := 1;
         pParent^.left := pCurrent;
      end
            else
                  if  ( x > pParent^.inf)  then
                      begin                   {добавляем новую вершину справа от родителя}
                          New (pCurrent);
                          pCurrent^.inf := x; pCurrent^.count := 1;
                          pParent^.right := pCurrent;
                      end
end;
end;



procedure view_backsym(pCur: TpNode;level: word);
var tmp: TpNode;
    i,j: word;
begin
if pCur <> nil then begin
   view_backsym(pCur^.Right,level+1);
   i := 0;
   while i < level do begin
         for j := 1 to 5 do write(' ');
         inc(i);
         end;
   writeln(pCur^.inf);
   view_backsym(pCur^.Left,level+1);
   end;
end;

procedure view_line(pCur: TpNode);
var tmp: TpNode;
begin
if pCur <> nil then begin
   view_line(pCur^.Right);
   write(pCur^.inf,'(',pCur^.count,') ');
   view_line(pCur^.Left);
   end;
end;


Procedure  DeleteNode(var pCurrent: TpNode;x: data);
Var  tmp : TpNode;

Procedure Changer ( var  p : TpNode);
var tmp: TpNode;
begin
if  p^.right <> nil  then  Changer(p^.right)
else begin
     tmp^.inf := p^.inf;
     tmp := p;
     p := p^.left;
     end;
end;

begin
if  pCurrent = nil  then  write('No such node!')
else
    if  x < pCurrent^.inf   then  DeleteNode(pCurrent^.left,x)
    else
        if  x > pCurrent^.inf   then  DeleteNode(pCurrent^.right,x)
        else begin
             tmp := pCurrent;
             if   tmp^.right = nil  then   pCurrent := tmp^.left
             else
                 if   tmp^.left = nil  then  pCurrent := tmp^.right
                 else Changer(pCurrent^.left);
             Dispose(tmp);
             end;
end;



procedure Init;
begin
     pRoot := nil;
end;


begin
  randomize;
  Init;
  repeat
  clrscr;
  writeln('1 - Add 1 Node(1)');writeln('2 - Add 1 Node(2)');
  writeln('3 - Add n Node (Create tree)'); writeln('4 - View');
  writeln('5 - View (line)'); writeln('6 - Find Node');
  writeln('7 - Destroy'); writeln('0 - Exit');
  write('Your answer: ');readln(ot);
  case (ot) of

     '1': begin clrscr; write('Type data: '); readln(tmp); addNode1(pRoot,tmp); end;

     '2': begin clrscr; write('Type data: '); readln(tmp); addNode2(tmp); end;

     '3': create;

     '4': begin clrscr; view_backsym(pRoot,0); readln; end;

     '5': begin clrscr; view_line(pRoot); readln; end;

     '6': begin clrscr; write('Type data: '); readln(tmp); FindNode(tmp); end;

     '7': begin clrscr; write('Type data: '); readln(tmp);
                DeleteNode(pRoot,tmp); readln; end;

    end;
  until (ot = '0');
end.