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

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

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

> Деревья
Aleks
сообщение 6.09.2005 7:22
Сообщение #1


Новичок
*

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

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


Здраствуйте
Прошу помощи в решение задачи: Подсчитать число вершин на n-ом уровне непустого дерева Т (корень считать вершиной нулевого дерева)
я в этом плохо разбираюсь, но кое-что написал

Исходный код
uses crt;
type
pitem=^titem;
titem=record
data:string;
pred:pitem;
next:pitem;
end;

var
first,last:pitem;
ff:text;
ss:string;
i:integer;

procedure add(ss:string);
var
newitem:pitem;
d:string;
begin
for i:=1 to length(ss) do
begin
d:=ss[1+length(ss)-i];
new(newitem);
newitem^.data:=d;
newitem^.pred:=nil;
newitem^.next:=first;
first:=newitem;
if last=nil then last:=newitem;
end;
end;

procedure print;
begin

end;

procedure del;
var
delitem:pitem;
begin
delitem:=first;
if delitem<>nil then
begin
first:=delitem^.next;
delitem^.Pred^.Next:=delitem^.Next;
dispose(delitem);
end;
end;

begin
{ clrscr; }
writeln('--' , memavail);

assign(ff,'E:\derevo.txt');
reset(ff);
while not (eof(ff)) do
begin
readln(ff,ss);
writeln(ss);
end;
add(ss);
del;
close(ff);
writeln('--' , memavail);
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 7.09.2005 14:52
Сообщение #2


Гость






Вот, что получилось:
(рекурсивный разбор строки с одновременным заполнением дерева. В результате получаем бинарное дерево, соответствующее заданному в строке корневому. PrintTreeGraph - для контроля результата, сама функция лежит здесь.

Собственно код:
uses crt, graph;

type
ttype = string[1];
binTreeWhere = (binRoot, binLeft, binRight);

pttree = ^ttree;
ttree = record
data: ttype;
left, right: pttree;
end;

var
global_root: pttree;
direction: binTreeWhere;

Procedure PrintTreeGraph;
Begin
{ сам текст процедуры }
End;

function add(var t: pttree; value: ttype;
where: binTreeWhere): pttree;

function CreateNode(value: ttype): pttree;
var p: pttree;
Begin
New(p);
p^.data := value;
p^.Left := nil;
p^.Right := nil;
createnode := p;
End;

begin
case where of
binRoot :
begin
t := createNode(value);
add := t;
end;
binLeft :
begin
t^.left := createNode(value);
add := t^.left;
end;
binRight :
begin
t^.right := createNode(value);
add := t^.right;
end;
end
end;


procedure build_tree(root: pttree; s: string);
var
i, count, start, finish: integer;
subs: string;
begin
if pos('(', s) + pos(')', s) = 0 then exit;
i := 1; count := 0;
while i <= length(s) do begin

if pos('(', copy(s, i, 255)) > 0 then begin

while s[i] <> '(' do inc(i);
start := i;

inc(count); inc(i);
while count > 0 do begin

if s[i] = '(' then inc(count)
else if s[i] = ')' then dec(count);
inc(i);

end;
finish := i;

subs := copy(s, succ(start), finish - start-2);

if pos('(', subs) < 2 then begin
if s[succ(start)] <> '(' then begin
root := add(root, subs, direction);
direction := binRight;
end;
end
else begin
root := add(root, s[succ(start)], direction);
direction := binLeft;
if global_root = nil then
global_root := root;
end;
build_tree(root, subs);

end
else break

end;

end;

const
s: string =
'(0(1(2((5)(6)))(3)(4))(7((8)(9(1)))))';
var
root: pttree;

var
grDriver: integer;
grMode: integer;
ErrCode: Integer;

begin
root := nil;
direction := binRoot;

build_tree(root, ' ' + s + ' ');

grDriver := Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln('Graphics error:', GraphErrorMsg(ErrCode)); Halt(100);
end;
PrintTreeGraph(global_root);
readln;
CloseGraph;
end.
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Aleks   Деревья   6.09.2005 7:22
klem4   Aleks, попробуй посмотреть вот тут : FAQ Динамичес...   6.09.2005 8:30
volvo   Aleks, у тебя дерево неправильно задано: оно должн...   6.09.2005 10:38
Aleks   спасибо klem4 за ссылку, полезная информация   6.09.2005 11:39
Aleks   проверьте правильно сделал или нет uses crt; type...   6.09.2005 13:02
volvo   Дело в том, что бинарные деревья так устроены, что...   6.09.2005 13:27
Aleks   есть файл derevo.txt , с которого считываются данн...   6.09.2005 14:26
volvo   Ах, вот оно что !!! :) Тогда тебе дума...   6.09.2005 14:59
volvo   Кстати, если задача не состоит в том, чтобы дерево...   6.09.2005 15:20
Aleks   volvo , я тебя понял, но цель работы Освоить основ...   7.09.2005 4:33
Aleks   Подскажите пожалуйста в решении задачи   7.09.2005 11:53
volvo   Минут через 20 выложу решение ;)   7.09.2005 13:03
volvo   Вот, что получилось: (рекурсивный разбор строки с ...   7.09.2005 14:52
Aleks   я вставил функцию PrintTreeGraph volvo ЭТО СУПЕР   8.09.2005 6:11
Aleks   volvo Помоги :molitva: я уже голову сломал, не...   9.09.2005 6:09
volvo   Ну, если вот эта процедура не устраивает, то приво...   9.09.2005 9:30
Aleks   где level - искомый уровень if (root<>nil)...   9.09.2005 10:35
volvo   Значит, ты неправильно вызываешь эту процедуру. Я ...   9.09.2005 10:44
Aleks   volvo я прикрепил файл (изображение дерева) я его ...   9.09.2005 11:38
volvo   Я же тебе говорю, что то, у чего ЕСТЬ хотя бы один...   9.09.2005 12:49
Aleks   Извини что тупил, теперь дошло Все работает просто...   9.09.2005 13:22


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

 



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