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

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

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

> Вершины бинарного дерева., Нужна помощь
TheKnyazz
сообщение 2.03.2009 19:16
Сообщение #1


Новичок
*

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

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


Добрый день! Нужна небольшая помощь. Задача имеет такое условие: По уровнево распечатать вершины бинарного дерева снизу вверх. Слабо понимаю как надо это сделать. Понимаю, что надо подсчитать количество вершин, потом создать две рекурсии одна будет в цикле начиная с последнего увронвя вершин посылать переменную в другую функцию которая будет идитить, пока не достигнет переданного значения, когда достигнет, должна распечатать, и так каждый раз, пока не дойдет до начала. Но как это реализовать, не могу понять. У меня даже полноценный подсчет вершин почему-то очень криво получается...
вот моя горе-программа, был бы рад, если б кто-нибудь обьяснил...

Program derevo;
Uses Crt;

Type inform = Integer;
ss = ^zveno;
zveno = Record
key: Integer;
inf: Inform;
left, right: ss;
End;

Var t:ss;
n,nn,c,i,k: Integer;

Procedure Search(tt:ss; var k:integer);
begin
if (tt^.right<>nil) and (tt^.left<> nil) then
Begin
search(tt^.right,k);
k:=k+1;
search(tt^.left,k);
End
else
if (tt^.right<>nil) or (tt^.left<>nil) then
begin

k:=k+1;
if tt^.right<> nil then search(tt^.right,k);
if tt^.left<>nil then search(tt^.left,k);
end;
end;


Procedure Vstavka (Var p: ss; x: Integer);
Begin
If p = Nil Then
Begin
New (p);
p^.inf:=x;
p^.key:=1;
p^.left:=Nil;
p^.right:=Nil;
End;
If x<p^.inf Then Begin Vstavka (p^.left,x); End;
If x>p^.inf Then Begin Vstavka (p^.right,x); End;
End;



Procedure Print (Var p: ss; h: Integer);
Var i: Integer;
Begin
If p <> Nil Then
Begin
Print(p^.right,h+4);
For i:=1 To h Do Write (' ');
Writeln (p^.inf);
Print (p^.left,h+4);
End;
End;

Begin

Writeln ('Vvedite koli4estvo klju4ej: ');
Readln (n);
For i:=1 To n Do
Begin
Read ©;
Vstavka (t,c);
End;
Print (t,c);
k:=0;
Search(t,k);
writeln(k);
Readln;
readln;
End.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 2)
volvo
сообщение 2.03.2009 19:26
Сообщение #2


Гость






Я ж вроде тебе на одном из форумов уже показывал... Или это был не ты?

Было предложено решение:
function GetHeight(tree: ttree): integer;
function max(a, b: integer): integer;
begin
if a > b then max := a else max := b;
end;
var
leftHeight, rightHeight: integer;
begin
if tree^.left = nil then leftHeight := 0
else leftHeight := GetHeight(tree^.left);
if tree^.right = nil then rightHeight := 0
else rightHeight := GetHeight(tree^.right);
GetHeight := 1 + max(leftHeight, rightHeight)
end;
procedure PrintLevel(level: integer; root: ttree;
const to_print: integer);
begin
if (root = nil) or (level > to_print) then exit;
if level = to_print then write(root^.value, #32)
else begin
printlevel(level + 1, root^.right, to_print);
printlevel(level + 1, root^.left, to_print);
end;
end;
, вызывать:
  for i := GetHeight(mytree) downto 0 do PrintLevel(0, mytree, i);
Так пойдет?
 К началу страницы 
+ Ответить 
TheKnyazz
сообщение 2.03.2009 23:28
Сообщение #3


Новичок
*

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

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


Большое спасибо) Вы обьясняли точно не мне) я 2-й раз обычно не спрашиваю) Я искал примеры, но почему-то не смог найти) Я думал, что здесь нужно было больше изощрятся...а оказалось все гораздо проще...Еще раз большое спасибо!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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