1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
здравствуйте,помогите если можете...задача у меня простая,но я че-то недогоняю, у меня есть бинарное дерево,я читаю данные с клавиатуры и хочу вывести мое дерево на экран,скажите в чем тут моя ошибка и как ее исправить?(я знаю что у вас есть ссылки на готовую прогу на бинарные деревья,где уже имеется процедура печати,но мне не хочется плагиатить-хочется разобраться в чем я не прав,так сказать научиться)
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
у меня есть бинарное дерево,я читаю данные с клавиатуры и хочу вывести мое дерево на экран
Неправда... У тебя нет никакого бинарного дерева (tree = nil, не забыл? У тебя есть структура, описывающая дерево, но сами элементы дерева отсутствуют), и ты хочешь одновременно читать данные с клавиатуры, создавать дерево и выводить его на экран?
"Не пытайся объять необъятного" (С) Козьма Прутков Разбей это действие на подзадачи: сначала - заполнение дерева, а уж потом - его печать.
Неправда... У тебя нет никакого бинарного дерева (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;
Блин... Опять не заметил... Нет, с деревом все в порядке, это просто тройка "вылезла" левее "семерки", а семерка, соответственно, ушла вправо.. Значит, надо делать так, как я делал для графического вывода дерева:
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;
Конечно, все усложнилось, но по крайней мере для 3-х или 4-х уровней дерева отрабатывает нормально, без наложений... Вот что показывает для того же дерева:
Обходишь дерево, находишь элемент с заданным значением, и применяешь к его левому потомку рекурсивную процедуру удаления поддерева... Ты ее реализовал, я надеюсь?
Обходишь дерево, находишь элемент с заданным значением, и применяешь к его левому потомку рекурсивную процедуру удаления поддерева... Ты ее реализовал, я надеюсь?
на данном этапе,я встал вступр в случае если корень входит в удаленное значение...вот что у меня получилось..
Код
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;
С использованием приведенной у меня на сайте функции 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) и т.д.
Что не получается? Говори конкретнее. Почему volvo тебе приводит точную и полную информацию, а ты бросаешь обрывки фраз, в которых 30% - междометия и ругательства? Это ему надо, а не тебе?..
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Извините,теперь будуболее конкретно задавать вопросы (забываюсь) !!! я просто хотел сказать,что при создании дерева при числах, например:20 25 17 18 19 16 30 22 и при задании числа ta=19(задача:нужно удалить из бинарного дерева все числа меньшие заданного)-программа удаляет и число 19 тоже,хотя не должно ,вот в этом и проблема?
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 - то получишь пошаговый показ, что именно удаляется...
А в следующий раз, если что-то не получается, то приаттачивай программу полностью...
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;
Пожалуйста... Кусок процедуры remove_less из твоего кода:
if p^.inf < ta then begin remove_less(p,p^.inf); { <--- Я этого не писал, это ты придумал } obxod2:=false; exit; end
Remove и remove_less - разные вещи, правда? Первый удаляет узел с заданным значением из дерева, второй делает нечто другое. Тебе нужен первый... Реализация есть на сайте...