IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> бинарное дерево, нужна помощь
serega204
сообщение 27.10.2009 9:33
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 30
Пол: Мужской
Реальное имя: serega

Репутация: -  0  +


Помогите пожалуйста, ничего не понимаю.....
Написать программу, которая создаёт бинарное дерево, каждый элемент которого символ. Напечатать все элементы дерева. Выбрать и напечатать элементы, которые являются листами дерева. Определить есть ли среди листьев заданный символ....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 7.11.2009 15:43
Сообщение #2


Гость






serega204, ты не спрашивай, смогу я тебе помочь, не смогу. Я на форуме не один. Кто-нибудь обязательно поможет. А в приват мне задавать вопросы по программированию - практически бессмыссленно, я на них не отвечаю, для этого есть форум. По поводу твоего вопроса:

нет, твой код работает неправильно. Он вылетает при печати дерева, потому что надо сравнивать не так:
Цитата
Procedure PrintTree(tree : Node);
Begin
Write(tree^.info, ' ');
If tree^.left = Nil then PrintTree(tree^.left);
If tree^.right = Nil then PrintTree(tree^.right)
End;
, а как минимум - вот так:
Procedure PrintTree(tree : Node);
Begin
Write(tree^.info, ' ');
If tree^.left <> Nil then PrintTree(tree^.left);
If tree^.right <> Nil then PrintTree(tree^.right)
End;
, т.е., не пытаться переходить по нулевому указателю, а предотвращать это. Вот программа, реализующая твое задание (я не стал менять твою процедуру NewTree, и код, заполняющий дерево, поменял только то, что не работало):
Program LR_3;
Type
Node = ^Bder;
Bder = record
info : char;
left, right : Node;
end;

Var
tree : Node;
i, N : Integer;
info : Char;

{ Создание нового бинарного дерева }
Procedure NewTree(info : Char; Var tree : Node);
Var P, pr, T: Node;
Begin
New(T);
T^.info := info;
T^.left := Nil;
T^.Right := Nil;
P := tree; Pr := Nil;
While p <> Nil do
Begin
Pr := P;
If p^.info > info then P := P^.left
else P := P^.right;
End;
If tree = Nil then tree := T
else
If Pr^.info > info then Pr^.left := T
else Pr^.right := T;
End;

{ Процедура обхода дерева }
Procedure PrintTree(level: integer; tree : Node);
Begin
If tree <> nil then
with tree^ do
begin
Writeln('':2*level, info);
PrintTree(level + 1, Left);
PrintTree(level + 1, Right);
end;
End;

{
Печатаем листья, одновременно подсичтывая, сколько из них
равны Ch
}
procedure PrintLeafs(ch: char; Tree: node; var count: integer);
begin
if tree <> nil then
begin
PrintLeafs(ch, tree^.Left, count);
if (tree^.Left = nil) and (tree^.Right = nil) then
begin
write(tree^.info:2);
if ch = tree^.info then inc(count);
end;
PrintLeafs(ch, tree^.Right, count);
end
end;

{ Удаление дерева }
Procedure DeleteTree(P : Node);
Begin
If P^.left <> Nil then DeleteTree(P^.left);
If P^.right <> Nil then DeleteTree(p^.right);
Dispose(P);
P := Nil;
End;

var
counter: integer;

{ Основная программа }
Begin
Write('Введите количество элементов дерева: '); Readln(N);
tree := Nil;
For i := 1 to N do
Begin
Write(i, ' элемент = '); Readln(info);
NewTree(info, tree);
End;

If tree = nil then Writeln('Пустое дерево')
else
begin
Writeln('Обход дерева:');
PrintTree(0, tree);

write('Введите символ (для поиска в листьях): '); readln(info);

writeln('Листья:');
counter := 0;
PrintLeafs(info, tree, counter);
writeln;

writeln('Среди листьев найдено ', Сounter, ', равных заданному символу');

DeleteTree(tree);
end;

Readln;
End.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 19.07.2025 16:43
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"