бинарные деревья Опции

[biv171]

здравствуйте,помогите если можете...задача у меня простая,но я че-то недогоняю, у меня есть бинарное дерево,я читаю данные с клавиатуры и хочу вывести мое дерево на экран,скажите в чем тут моя ошибка и как ее исправить?(я знаю что у вас есть ссылки на готовую прогу на бинарные деревья,где уже имеется процедура печати,но мне не хочется плагиатить-хочется разобраться в чем я не прав,так сказать научиться)

program derevo;
uses crt;
type pstruct=^struct;
     struct= record
             inf:integer;
             left,right:pstruct;
            end;
var n,y,x,q,w,m:integer;
 tree:pstruct;
    z:struct;


function  newd(x:integer):pstruct;
 var p:pstruct;
 begin
  new(p);
  p^.inf:=x;
  p^.left:=nil;
  p^.right:=nil;
  newd:=p;
 end;

procedure setleft(p:pstruct;x:integer);
 begin
  p^.left:=newd(X);
 end;

procedure setright(p:pstruct;x:integer);
 begin
  p^.right:=newd(x);
 end;



 procedure viv(p:pstruct;m:integer);
  begin
    read(n);
    while not eoln do if p=nil then begin
                                     p:=newd(n);
                                     gotoxy(q,w);
                                     write(p^.inf);
                                     read(n);
                                    end
                                else if p^.inf<n then begin
                                                  setright(newd(p^.inf),n);
                                                  gotoxy(q+17,w+1);
                                                  writeln(n);
                                                  {q:=q+17;
                                                  w:=w+1;}
                                                  viv(newd(n),n);
                                                  end
                                            else begin
                                                  setleft(newd(p^.inf),n);
                                                  gotoxy(q-17,w+1);
                                                  writeln(n);
                                                  {q:=q-17;
                                                  w:=w+1;}
                                                  viv(newd(n),n);
                                                 end;


 end;

 begin
  clrscr;
  tree:=nil;
  q:=40;
  w:=1;
  viv(tree,m);
  readln;
 end.

М

При публикации программ используй теги (выделить, применить нужную опцию меню CODE) Lapp

[volvo]

biv171, смотри чего я придумал:

ydalenie  = 19                         20
                             /                   \
                   25                                      19
              /        \
         30                 22

Это по твоему условию - после удаления... А собственно удаление делается вот так:

procedure remove_less(var root: pstruct; ta: integer);

  function obxod(var p: pstruct; ta: integer): boolean;
  var b: boolean;
  begin
    if p = nil then begin
      obxod := true; exit;
    end;

    if p^.inf < ta then begin
      remove(p, p^.inf); obxod := false; exit;
    end
    else begin
      obxod := false;
      if not obxod(p^.left, ta) then exit;
      if not obxod(p^.right, ta) then exit;
      obxod := true;
    end;
  end;

begin { remove_less }
  while not obxod(root, ta) do begin
    {
    clrscr;
    writeln('one more repaint');
    print(root,1,0,40,80);
    readkey;
    }
  end;
end; { remove_less }

{ Вызывается очень просто: }
readln(q);
remove_less(tree, q);

Если раскомментируешь то, что в цикле While - то получишь пошаговый показ, что именно удаляется...

А в следующий раз, если что-то не получается, то приаттачивай программу полностью...

[biv171]

biv171, смотри чего я придумал:

ydalenie  = 19                         20
                             /                   \
                   25                                      19
              /        \
         30                 22

Это по твоему условию - после удаления... А собственно удаление делается вот так:

procedure remove_less(var root: pstruct; ta: integer);

  function obxod(var p: pstruct; ta: integer): boolean;
  var b: boolean;
  begin
    if p = nil then begin
      obxod := true; exit;
    end;

    if p^.inf < ta then begin
      remove(p, p^.inf); obxod := false; exit;
    end
    else begin
      obxod := false;
      if not obxod(p^.left, ta) then exit;
      if not obxod(p^.right, ta) then exit;
      obxod := true;
    end;
  end;

begin { remove_less }
  while not obxod(root, ta) do begin
    {
    clrscr;
    writeln('one more repaint');
    print(root,1,0,40,80);
    readkey;
    }
  end;
end; { remove_less }

{ Вызывается очень просто: }
readln(q);
remove_less(tree, q);

Если раскомментируешь то, что в цикле While - то получишь пошаговый показ, что именно удаляется...

А в следующий раз, если что-то не получается, то приаттачивай программу полностью...

volvo,я все-таки сделал поспешный вывод,то что разобрался,я написал процедуру remove_less,но она у меня зацикливается и ничего не меняет,укажи ошибки пожайлуста..

program derevo;
uses crt;
const dely=2;
       btw=1;
type pstruct=^struct;
     struct= record
             inf:integer;
             left,right:pstruct;
            end;

var n,y,x,w,m,start_x,start_y,yzel:integer;
 tree:pstruct;
    z:struct;
    q:byte;


procedure newd(var p:pstruct;x:integer);
 begin
  new(p);
  p^.inf:=x;
  p^.left:=nil;
  p^.right:=nil;
 end;



 procedure zapolnenie(var tec:pstruct;n:integer);
  begin
   if tec=nil then newd(tec,n)
              else with tec^ do begin
                                 if inf<n then zapolnenie(right,n)
                                 else if inf>n then zapolnenie(left,n)
                                end;
  end;


procedure print(tec:pstruct;level:integer;l,c,r:integer);
 function min(a,b:integer):integer;
  begin
   min:=a;
   if b < a then min:=b;
  end;
 function center(a,b:integer):integer;
  begin
   center:=min(a,B)+abs( a - B) div 2;
  end;
 var pos_y:integer;
 begin
  pos_y:=start_y+ pred(level)*dely;
  if tec^.left<>nil then begin
                          gotoxy(center(c, center(c+btw,r-btw)),pos_y+1);
                          write('\');
                          print(tec^.left,level+1,c+btw, center(c+btw,r-btw),r-btw);
                         end;
  if tec^.right<>nil then begin
                           gotoxy(center(c,center(l+btw,c-btw)),pos_y+1);
                           write('/');
                           print(tec^.right,level+1,l+btw,center(l+btw,c-btw),c-btw);
                          end;
  gotoxy(c,pos_y);
  write(tec^.inf);
 end;




 procedure delete(var p:pstruct);
  begin
   if p=nil then exit;
   delete(p^.right);
   delete(p^.left);
   dispose(p);
   p:=nil;
  end;


 procedure ud_uz(var tec:pstruct;ta:byte);
  var wasnext:pstruct;
   function ud(var tec:pstruct):integer;
    var wasroot:pstruct;
    begin
     if tec^.left=nil then begin
                            ud:=tec^.inf;
                            wasroot:=tec;
                            tec:=tec^.left;
                            dispose(wasroot);
                           end
                      else ud:=ud(tec^.left);
   end;

  begin
   if tec<>nil then
    if ta<tec^.inf then ud_uz(tec^.left,ta)
     else if ta>tec^.inf then ud_uz(tec^.right,ta)
      else if (tec^.left=nil)and (tec^.right=nil)
       then begin
             dispose(tec);
             tec:=nil;
            end
       else if tec^.left=nil then begin
                                   wasnext:=tec^.right;
                                   dispose(tec);
                                   tec:=wasnext;
                                  end
                             else if tec^.right=nil then begin
                                                          wasnext:=tec^.left;
                                                          dispose(tec);
                                                          tec:=wasnext;
                                                         end
                                                   else tec^.inf:=ud(tec^.right);


 end;


procedure remove_less(var tec: pstruct;ta:integer);
 function obxod2(var p:pstruct;ta:integer):boolean;
  var b:boolean;
  begin
   if p=nil then begin
                  obxod2:=true;
                  exit;
                 end;
   if p^.inf < ta then begin
                        remove_less(p,p^.inf);
                        obxod2:=false;
                        exit;
                       end
                  else begin
                        obxod2:=false;
                        if not obxod2(p^.left,ta) then exit;
                        if not obxod2(p^.right,ta) then exit;
                        obxod2:=true;
                       end;
   end;
  begin
   while not obxod2(tec,ta) do begin
                                clrscr;
                                writeln('one more repaint');
                                print(tec,1,0,40,80);
                                readkey;
                               end;
  end;




procedure obxod(var tec:pstruct;yzel:integer);
  var old:pstruct;
  begin
   if yzel<tec^.inf then obxod(tec^.left,yzel)
   else if yzel>tec^.inf then obxod(tec^.right,yzel)
   else begin

        if tec^.right<>nil then begin
                                  old:=tec;
                                  tec:=tec^.right;
                                  write(tec^.inf);
                                  tec:=old;
                                 end
                            else write('nil');
        if tec^.left<>nil then begin
                                 tec:=tec^.left;
                                 write(' ',tec^.inf);
                                end
                           else write(' nil');
         end;
  end;



 begin
  clrscr;
  tree:=nil;
  start_x:=40;
  start_y:=1;
  while not eoln do begin
                     read(n);
                     zapolnenie(tree,n);
                    end;
  print(tree,1,0,40,80);
  readkey;
  clrscr;
  write('delete numbers = ');
  readln(q);
  remove_less(tree,q);
  {while tree^.inf<q do ud_uz(tree,tree^.inf);}
  {print(tree,1,0,40,80);}
 { readkey;}
 { clrscr;}
 {delete(tree^.left);}
  {print(tree,1,0,40,80);
  readkey;}
  gotoxy(1,10);
  write('naiti yzel= ');
  readln(yzel);
  obxod(tree,yzel);
  readkey;

 end.