Помощь - Поиск - Пользователи - Календарь
Полная версия: бинарные деревья
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
alecsandr
Помогите сделать так что бы правое, левое поддерево и корень выводилось по отдельности, а не так как у меня. Комменты я добавил если что не ясно спросите.
 {Разработайте программу работы с бинарным деревом.
Программа должна содержать следующие процедуры,
вызываемые из меню:
- построение пустого дерева;
- вставка поддерева в указанное место;
- удаление указанного элемента;
- просмотр дерева в следующем порядке: правая ветвь, левая ветвь, узел}
program treework;
uses CRT,Graph;

type PTree = ^TTree;
TTree = record
info:byte;
left,right: PTree;
end;

function getint(ident:string):byte;
var s:byte;
begin
write('vvedite ',ident,' : ');
readln(s);
getint:=s;
end;
procedure CreateTree (var root:PTree;info:byte);
var elem:PTree;
begin
if (root<>NIL) then
begin
new(elem);
elem^.left:=NIL;
elem^.right:=NIL;
elem^.info:=info;
end
else
if (info>root^.info) then
CreateTree(root^.left,info);

end;


procedure addelem(var root:PTree;info:byte);
var elem:PTree;
begin
if (root=NIL) then (* если дерево пустое, то *)
begin
new(elem); (* Создать новый лист *)
elem^.left:=NIL;
elem^.right:=NIL;
elem^.info:=info; (* Записать туда значение требуемого элемента *)
root:=elem; (* Присоединить новый лист вместо пустого дерева *)
end
else (* Иначе *)
begin
if (info<root^.info) then (* Если добавляемое значение меньше текущего узла, то *)
addelem(root^.left,info) (* Добавить его в левое поддерево *)
else (* Иначе *)
addelem(root^.right,info); (* Добавить его в правое поддерево *)
end;
end;


procedure printLKP(root:PTree);
begin
if (root<>NIL) then (* Если дерево не пустое *)
begin
printLKP(root^.right); (* Распечать правое поддерево *)
printLKP(root^.left); (* Распечатать левое поддерево *)
write(root^.info,' '); (* Распечатать корень дерева *)

end;
end;

procedure printLKP_wrapper(root:PTree);
begin
clrscr;
if (root=NIL) then (* Если дерево пустое *)
writeln('Derevo pusto!') (* Сообщить об этом *)
else (* Иначе *)
PrintLKP(root); (* Распечатать дерево *)
writeln;
writeln('nagmite lubyu klafshu dly vixoda iz menu');
readkey;
end;


procedure delelem(var root:PTree;info:byte);
var temp:PTree;
begin
if (root<>NIL) then (* Если дерево не пустое, то *)
begin
if (info<root^.info) then (* Если удаляемый элемент меньше тек. узла, то *)
delelem(root^.left,info) (* Удалить его из левого поддерева *)
else (* Иначе *)
if (info>root^.info) then (* Если удаляемый элемент больше тек. узла, то *)
delelem(root^.right,info) (* Удалить его из правого поддерева *)
else (* Иначе тек. узел - удаляемый элемент *)
begin
if (root^.left=NIL) and (root^.right=NIL) then (* Если тек. узел - лист, то *)
begin
dispose(root); (* Удалить его *)
root:=NIL; (* Поставить на его место пустое дерево *)
end
else
if (root^.left=NIL) and (root^.right<>NIL) then (* Если у тек.узла есть только правая ветвь *)
begin
temp:=root; (* Присоединить её вместо тек. узла *)
root:=root^.right;
dispose(temp); (* Удалить тек. узел *)
end
else
if (root^.left<>NIL) and (root^.right=NIL) then (* Если у тек.узла есть только левая ветвь *)
begin
temp:=root; (* Присоединить её вместо тек. узла *)
root:=root^.left;
dispose(temp); (* Удалить тек. узел *)
end


end;
end;
end;

procedure showmenu;
begin
clrscr;
writeln(' Binarnoe derevo');
writeln;
writeln(' 1) Dobavit element');
writeln(' 2) raspechatat derevo right vetv - left vetv - koren - ');
writeln(' 3) Ulalit element');
writeln(' 4) sozdanie dereva');
writeln(' 5) exit');
writeln;
write('vash vibor : ');

end;

Var Tree:PTree;
selection:integer;

begin
Tree:=NIL; (* Создать пустое дерево *)
repeat
showmenu; (* Вывести на экран меню *)
readln(selection); (* Считать с клавиатуры выбор пользователя *)
writeln;
case selection of (* Выполнить действия в соответствии с этим выбором *)
1: addelem(Tree,getint('element dlya dobavleniya'));
2: printLKP_wrapper(Tree);
3: delelem(Tree,getint('element dlya udaleniya'));
4: CreateTree(Tree,getint('derevo sozdano'));
5: clrscr;

end;
until selection=5;
end.
volvo
Цитата
Помогите сделать так что бы правое, левое поддерево и корень выводилось по отдельности, а не так как у меня.
Ты сначала сделай так, чтобы дерево нормально создавалось, а не так, как у тебя - вылетает при попытке выбрать "Создание дерева". Кстати, совершенно правильно делает, что вылетает: разыменование указателя, равного NIL, делать нельзя.
alecsandr
но мы делали на паре так, только вместо этого
"if (root<>NIL) then"
было
"if (root=NIL) then"
а можешь помочь исправить?
alecsandr
Так поможешь? А то я даж незнаю о чем ты говоришь(
volvo
Цитата
А то я даж незнаю о чем ты говоришь(
Не знаешь?

Объясняю... Вот кусок твоего кода, но с моими комментариями:
Цитата
procedure CreateTree (var root:PTree;info:byte);
var elem:PTree;
begin
// Допустим, у нас root = NIL. Что происходит?
if (root<>NIL) then // Условие не выполнится, вернет False, и уходим на ветку Else ...
begin
new(elem);
elem^.left:=NIL;
elem^.right:=NIL;
elem^.info:=info;
end
else // ... вот сюда.
if (info>root^.info) then // Но ведь у нас Root = NIL, что ж ты сделал? NIL^.info? Вылетаем ...
CreateTree(root^.left,info);
end;
Теперь понятнее?

Цитата
но мы делали на паре так, только вместо этого
"if (root<>NIL) then"
было
"if (root=NIL) then"
А вот теперь, если можно, объясни по порядку, почему ты поменял знак с "равно" на "НЕ равно"? Какими соображениями руководствовался?
alecsandr
На паре она сперва написала <> а потом, я не смотрел, и она поменяла на =.
volvo
А ты всегда не думая используешь тот или иной знак? Только потому, что на паре преподаватель "написал так"? Вообще-то надо думать, что произойдет в случае, если условие выполнится, и что - если не выполнится, и поступать так, как нужно. Мало ли чего преподаватель (да еще в последних числах декабря) напишет на доске.

Что произойдет, я тебе рассказал. Исправляй...
alecsandr
procedure CreateTree (var root:PTree;info:byte);
var elem:PTree;
begin
if (root=NIL) then
begin
new(elem);
elem^.left:=NIL;
elem^.right:=NIL;
elem^.info:=info;
end
else
if (info>root^.info) then
CreateTree(root^.left,info);
end;

ПоХОДУ ТАК я незнаю
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.