Помощь - Поиск - Пользователи - Календарь
Полная версия: бинарные деревья
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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
Цитата
у меня есть бинарное дерево,я читаю данные с клавиатуры и хочу вывести мое дерево на экран
Неправда... У тебя нет никакого бинарного дерева (tree = nil, не забыл? У тебя есть структура, описывающая дерево, но сами элементы дерева отсутствуют), и ты хочешь одновременно читать данные с клавиатуры, создавать дерево и выводить его на экран?

"Не пытайся объять необъятного" (С) Козьма Прутков Разбей это действие на подзадачи: сначала - заполнение дерева, а уж потом - его печать.

biv171
упс blink.gif это было бы лучше всего...
biv171
Цитата(volvo @ 18.11.2008 22:58) *

Неправда... У тебя нет никакого бинарного дерева (tree = nil, не забыл? У тебя есть структура, описывающая дерево, но сами элементы дерева отсутствуют), и ты хочешь одновременно читать данные с клавиатуры, создавать дерево и выводить его на экран?

"Не пытайся объять необъятного" (С) Козьма Прутков Разбей это действие на подзадачи: сначала - заполнение дерева, а уж потом - его печать.



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

Код
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 tec:pstruct;
begin
  new(tec);
  tec^.inf:=x;
  tec^.left:=nil;
  tec^.right:=nil;
  newd:=tec;
end;

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

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

procedure zapolnenie(tec:pstruct;z:struct);
  begin
   while not eoln do
    begin
     read(z.inf);
     if tec=nil then begin
                      tree:=newd(z.inf);
                      tec:=tree;
                     end
                else if z.inf<tec^.inf then
                  begin
                   setleft(tec,z.inf);
                   zapolnenie(tec^.left,z);                                              
                  end
                                       else begin
                                             setright(tec,z.inf);
                                             zapolnenie(tec^.right,z);          
                                            end;

                     end;
  end;




procedure soz(tec:pstruct;f:byte);
begin
y:=y+1;
if tec<>nil then begin
                 if f=1 then x:=x-27;
                 if f=2 then x:=x+15;
                 gotoxy(x,y);
                 if f=0 then writeln(tec^.inf);
                 if f=1 then writeln(tec^.inf,'/');
                 if f=2 then writeln('\',tec^.inf);
                 soz(tec^.left,1);
                 soz(tec^.right,2);
                end;
y:=y-1;
end;

{Основная программа}
begin
  clrscr;
  tree:=nil;
  x:=30;
  y:=0;
  window(5,1,100,25);
  zapolnenie(tree,z);
  soz(tree,0);
  readkey;

end.[code]
volvo
Цитата
я осознал свои ошибки по заполнению
Если б ты их осознал, то заполнение было бы правильным, а оно у тебя неправильное. Вывод делается вот так:

const
dx = 6;
procedure print(root: pstruct; xpos, ypos: integer; f, level: integer);
var px: integer;
begin
if root <> nil then begin
gotoxy(xpos + f*level, ypos);
write(root^.inf);

if root^.right <> nil then begin
px := xpos - (dx div 2) + f*level;
gotoxy(px, ypos + 1); write('/');
print(root^.right, px, ypos + 2, -1, level+1);
end;
if root^.left <> nil then begin
px := xpos + (dx div 2) + f*level;
gotoxy(px, ypos + 1); write('\');
print(root^.left, px, ypos + 2, 1, level+1);
end;

end;
end;

{ Вызов: }
print(tree, 40, 1, 0, 1);

, когда сделаешь правильное заполнение - получишь нормальную картинку:

1 4 8 2 7 3                            1
/
4
/ \
8 2
\ /
3 7

smile.gif Исправляй свою процедуру, заполняющую дерево...
biv171
volvo а почему 3 в левом поддереве(относительно 4) ведь она же меньше 4 она должна быть в правом???разве нет?тоже самое с 7?
volvo
Блин... Опять не заметил... Нет, с деревом все в порядке, это просто тройка "вылезла" левее "семерки", а семерка, соответственно, ушла вправо.. Значит, надо делать так, как я делал для графического вывода дерева:

procedure Print(Root: PStruct);
var
start_x, start_y: integer;
const
dely = 2;
btw = 1;

procedure print_node(Root: 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 Root^.Left <> nil then begin
gotoxy(Center(C, Center(C+btw, R-btw)), pos_y + 1); write('\');
print_node(root^.Left, Level + 1, C+btw, Center(C+btw, R-btw), R-btw);
end;

if Root^.Right <> nil then begin
gotoxy(Center(C, Center(L+btw, C-btw)), pos_y + 1); write('/');
print_node(Root^.Right, Level + 1, L+btw, Center(L+btw, C-btw), C-btw);
end;

GotoXY(C, pos_y);
write(root^.inf);
end;

begin
start_x := 40;
start_y := 1;
print_node(Root, 1, 0, 40, 80);
end;

Конечно, все усложнилось, но по крайней мере для 3-х или 4-х уровней дерева отрабатывает нормально, без наложений... Вот что показывает для того же дерева:

1 4 8 2 7 3                            1
/
4
/ \
8 2
\ /
7 3

biv171
господа,не могли бы еще помочь,мне нужно удалить из бинарного дерева все числа меньшие заданного:не могли бы вы дать совет как это сделать?
volvo
Обходишь дерево, находишь элемент с заданным значением, и применяешь к его левому потомку рекурсивную процедуру удаления поддерева... Ты ее реализовал, я надеюсь?
samec
Цитата(biv171 @ 21.11.2008 17:14) *

господа,не могли бы еще помочь,мне нужно удалить из бинарного дерева все числа меньшие заданного:не могли бы вы дать совет как это сделать?

FAQ -> Всё о динамических структурах данных
biv171
Цитата(volvo @ 21.11.2008 15:22) *

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


на данном этапе,я встал вступр в случае если корень входит в удаленное значение...вот что у меня получилось..

Код
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: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 tec:pstruct;ta:byte);
  begin
  if tec<>nil then begin
                    if (tec^.right<>nil) and (ta>tec^.inf) then delete(tec^.right,ta);
                    if (tec^.left<>nil) and (ta>tec^.inf) then delete(tec^.left,ta)
                    else delete(tec^.left,ta);
                    dispose(tec);
                    tec:=nil;
                   end;

end;

procedure obxod(var tec:pstruct;ta:byte);
  var old:pstruct;
  begin
   if ta<tec^.inf then obxod(tec^.left,ta)
                  else  if ta>tec^.inf then delete(tec,ta)
                  else obxod(tec^.left,ta);

  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('ydalenie  = ');
  readln(q);
  obxod(tree,q);
  print(tree,1,0,40,80);
  readkey;
end.
volvo
С использованием приведенной у меня на сайте функции Remove(root, value), удаление всех значений, меньших, чем заданное, может выглядеть вот так:

Procedure Delete(var p: pstruct);
Begin
If p = nil Then Exit;

Delete(p^.Right);
Delete(p^.Left);
Dispose(p); p := nil;
End;

{ ... }

{ Тут - заполнение дерева }
print(tree,1,0,40,80); readkey; { Показываем дерево целиком }
clrscr;

write('ydalenie = '); readln(q);

while tree^.inf < q do remove(tree, tree^.inf); { Пока корень подпадает под удаление - удаляем }
print(tree,1,0,40,80); readkey; { Показываем, что получилось на промежуточном этапе }

clrscr;
delete(tree^.left); { А теперь - удаляем левого потомка корня }
print(tree,1,0,40,80); readkey;

Проверялось на
1, 4, 8, 2, 3, 7 (удалить меньшие чем 4)
1, 4, 8, 2, 3, 7, 6, 5 (удалить меньшие чем 6)
и т.д.
biv171
эх блин при 3 не получается....(
Lapp
Цитата(biv171 @ 22.11.2008 0:34) *
эх блин при 3 не получается....(

Что не получается? Говори конкретнее. Почему volvo тебе приводит точную и полную информацию, а ты бросаешь обрывки фраз, в которых 30% - междометия и ругательства? Это ему надо, а не тебе?..
biv171
Извините,теперь будуболее конкретно задавать вопросы (забываюсь) !!!
я просто хотел сказать,что при создании дерева при числах, например:20 25 17 18 19 16 30 22 и при задании числа ta=19(задача:нужно удалить из бинарного дерева все числа меньшие заданного)-программа удаляет и число 19 тоже,хотя не должно ,вот в этом и проблема?
Lapp
Цитата(biv171 @ 22.11.2008 1:13) *
будуболее конкретно задавать вопросы

Я думаю, было бы крайне полезно, если бы ты привел текущий вариант проги.
volvo
biv171, смотри чего я придумал: cool.gif

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
Спасибо огромное разобралсяsmile.gif) smile.gif
biv171
Цитата(volvo @ 22.11.2008 2:27) *

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

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.




volvo
Цитата
укажи ошибки пожайлуста..
Пожалуйста... Кусок процедуры remove_less из твоего кода:
   if p^.inf < ta then begin
remove_less(p,p^.inf); { <--- Я этого не писал, это ты придумал }
obxod2:=false;
exit;
end

Remove и remove_less - разные вещи, правда? Первый удаляет узел с заданным значением из дерева, второй делает нечто другое. Тебе нужен первый... Реализация есть на сайте...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.