Помощь - Поиск - Пользователи - Календарь
Полная версия: Деревья
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Aleks
Здраствуйте
Прошу помощи в решение задачи: Подсчитать число вершин на 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.
klem4
Aleks, попробуй посмотреть вот тут : FAQ Динамические структуры данных
volvo
Aleks, у тебя дерево неправильно задано: оно должно задаваться так:
Type
PTree = ^TNode;
TNode = Record
Data: TType; { любой тип, который тебе нужно хранить в дереве }
Left, Right: PTree;
End;
, а процедуры создания/удаления дерева - рекурсивны... Их можешь найти в нашем FAQ-е по ссылке которую дал klem4. Нужная тебе процедура будет выглядеть вот так:
var count: integer; { изначально = 0 }
procedure level_n(root: ptree; level, curr_level: integer);
begin
if (root<>nil) then begin
if (curlevel = level) then inc(count) { просто увеличить счетчик }
else begin
level_n(root^.left, level, succ(curlevel)); { проход левого поддерева }
level_n(root^.right, level, succ(curlevel)); { проход правого поддерева }
end;
end;
end;
Aleks
спасибо klem4 за ссылку, полезная информация
Aleks
проверьте правильно сделал или нет

Исходный код
uses crt;
type
ttype=record
n:integer;
count:integer;
end;

TTree=^TNode;
TNode=Record
data:TType;
Left, Right:TTree;
end;

var
t:TTree;
ff:text;
d,ss:string;
i:integer;

procedure add(var T: TTRee; i:Integer);

procedure CreateNode(var p:TTRee; n:integer);
begin
new(p);
p^.Data.n:=n;
p^.Data.Count:=1;
p^.Left:=nil;
p^.Right:=nil;
end;

begin
if t<>nil then
with t^ do
begin
if Data.n<i then Add(Right,i)
else
if Data.n>i then Add(Left,i)
else Inc(Data.Count)
end
else
CreateNode(T,i);
end;

procedure Delete(T: TTRee);
begin
if T=nil then Exit;

delete(T^.Right);
delete(T^.left);
dispose(t);
end;


begin
writeln('--' , memavail);

assign(ff,'E:\derevo.txt');
reset(ff);
while not (eof(ff)) do
begin
readln(ff,ss);
{writeln(ss);}
end;
for i:=1 to length(ss) do
begin
d:=ss[1+length(ss)-i];
add(T,1);
end;
delete(t);
close(ff);

writeln('--' , memavail);
readln;
end.


вопрос: по процедуре add, я хотел бы понять ее действие

Код

 if t<>nil then
 with t^ do
 begin
   if Data.n<i then Add(Right,i)
   else
     if Data.n>i then Add(Left,i)
       else Inc(Data.Count)
 end
 else
   CreateNode(T,i);
volvo
Цитата(Aleks @ 6.09.05 13:02)
вопрос: по процедуре add, я хотел бы понять ее действие
Дело в том, что бинарные деревья так устроены, что
Цитата(FAQ:Деревья)
для каждого узла выполняется правило: в левом поддереве содержатся только ключи, имеющие значения, меньшие, чем значение данного узла, а в правом поддереве содержатся только ключи, имеющие значения, большие, чем значение данного узла.

Отсюда и реализация Add:
Procedure Add(Var T: TTree; i: Integer);

Procedure CreateNode(Var p: TTree; n: Integer);
Begin { ... } End;

Begin
If T <> nil Then { если текущий корень не пустой, то ... }
With T^ Do Begin
{ ... если элемент данных > корневого }
If Data.n < i Then Add(Right, i) { то добавить его в правое поддерево }
Else { ... если элемент данных < корневого }
If Data.n > i Then Add(Left, i) { то добавить его в левое поддерево }

{
если добавляемый и корневой элемент равны,
то просто увеличить счетчик значений корневого элемента
}
Else Inc(Data.Count)
End
Else { текущий корень пуст, то есть элемент должен быть создан }
CreateNode(T, i) { тогда создаем его ... }
End;


А по поводу твоей программы - я например не понял, почему ты добавляешь только единицы в дерево... В результате ты получишь не дерево, в один только корневой элемент, значение N которого будет равно 1, а Count будет равен длине последней строки файла (ибо все остальные строки ты пропускаешь)... Смысл такой программы в чем? Что ты хотел, чтобы содержалось в дереве?

Скорее всего, тебе надо добавлять НЕ целые числа, а символы или строки, так поменяй типы там где надо...
Aleks
есть файл derevo.txt , с которого считываются данные (дерево методом вложенных скобок (0(1(2((5)(6)))(3)(4))(7((8)(9(1))))) )

я решил сделать так

Код

for i:=1 to length(ss) do
 begin
   {write('- ',d);}
   case ss[i] of
     '0'..'9': begin  add(T,ss[i]); write('  ',ss[i],' '); end;
     '(': zn:=true;
     ')': zn:=false;
   end;
 end;


но как сделать в процедуре add
я предположил так, но здесь не совсем правильно, дерево должно ветвится


0-1-2-5
-------6
-----3
-----4
---7-8
-----9-1


Код

begin
 if t<>nil then
 with t^ do
 begin
   if zn=true then Add(Right,i)
   else
     if zn=false then Add(Left,i)
       else Inc(Data.Count)
 end
 else
   CreateNode(T,i);
end;


помогите, в каком направление думать
volvo
Ах, вот оно что !!! smile.gif Тогда тебе думать надо СОВСЕМ в другом направлении... Методом вложенных скобок представляется НЕ бинарное, а КОРНЕВОЕ дерево. Забудь все то, что я предлагал выше, то было для бинарных (2 потомка у каждого узла - Left и Right)... У корневого может быть гораздо больше потомков, поэтому процедуры добавления/удаления будут другими...
volvo
Кстати, если задача не состоит в том, чтобы дерево построить, а достаточно только подсчитать количество узлов на N-ом уровне, то можно просто парсить строку:
const needed_level = 3;
var
level, count: integer; { = 0 }
changed: boolean; { = false}
...
for i:=1 to length(ss) do begin
case ss[i] of
'0'..'9': ;
'(': begin inc(level); changed := true; end;
')': begin dec(level); chenged := true; end;
end;
if changed then
if level = needed_level then begin
inc(count); changed := false;
end;
end;

Что-то в этом духе...
Aleks
volvo , я тебя понял, но цель работы
Освоить основные способы представления деревьев в оперативной памяти ЭВМ и практически реализовать алгоритмы работы с деревьями
т.е. мне нужно построить дерево

за алгоритм подсчета количество узлов спасибо
Aleks
Подскажите пожалуйста в решении задачи
volvo
Минут через 20 выложу решение ;)
volvo
Вот, что получилось:
(рекурсивный разбор строки с одновременным заполнением дерева. В результате получаем бинарное дерево, соответствующее заданному в строке корневому. 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
я вставил функцию PrintTreeGraph
volvo ЭТО СУПЕР
Aleks
volvo Помоги :molitva:
я уже голову сломал, не могу придумать, как вычислить кол-во вершин на n-уровне непустого дерева Т (корень считать вершиной нулевого дерева)
volvo
Ну, если вот эта процедура не устраивает, то приводи свое определение "вершины":
var count: integer; { изначально = 0 }
procedure level_n(root: pttree; level, curr_level: integer);
begin
if (root<>nil) then begin
if (curr_level = level) and { находимся на нужном уровне }
{ у узла есть хотя бы один потомок, то есть это - "вершина", а не "лист" }
((root^.left <> nil) or (root^.right <> nil))
then inc(count) { просто увеличить счетчик }
else begin
level_n(root^.left, level, succ(curr_level)); { проход левого поддерева }
level_n(root^.right, level, succ(curr_level)); { проход правого поддерева }
end;
end;
end;
Aleks
где level - искомый уровень


if (root<>nil) then - он не выполняет условие (т.е. выходит из процедуры)
volvo
Значит, ты неправильно вызываешь эту процедуру. Я только что проверил - все работает... Попробуй основную часть программы (пост №13) сделать вот такой, и добавить мою процедуру:
begin
root := nil;
direction := binRoot;

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

count := 0;
level_n(global_root, 3, 1);
WriteLn('deepth = 3; count = ', count);
end.
Aleks
volvo
я прикрепил файл (изображение дерева)
я его правильно понимаю,
что на 1,2 уровень вершин нет
3 уровень 2 вершины
4 уровень 3 вершины
5 уровень 1 вершина
volvo
Я же тебе говорю, что то, у чего ЕСТЬ хотя бы один потомок - это "вершина". То, у чего НЕТ потомков - "лист". Моя процедура (пост №16) ищет число "вершин". Если тебе нужны "листья" - то условие
    if (curr_level = level) and { находимся на нужном уровне }
((root^.left <> nil) or (root^.right <> nil))

меняй на
    if (curr_level = level) and { находимся на нужном уровне }
((root^.left = nil) and (root^.right = nil))
Aleks
Извини что тупил, теперь дошло
Все работает просто СУПЕР

БОЛЬШОЕ СПАСИБО ЗА ПОМОЩЬ volvo
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.