Деревья Опции

[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 Динамические структуры данных

Сообщение отредактировано: klem4 - 6.09.2005 8:31

[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]

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

Дело в том, что бинарные деревья так устроены, что

для каждого узла выполняется правило: в левом поддереве содержатся только ключи, имеющие значения, меньшие, чем значение данного узла, а в правом поддереве содержатся только ключи, имеющие значения, большие, чем значение данного узла.

Отсюда и реализация 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;

помогите, в каком направление думать

Сообщение отредактировано: Aleks - 6.09.2005 14:28

[volvo]

Ах, вот оно что !!! Тогда тебе думать надо СОВСЕМ в другом направлении... Методом вложенных скобок представляется НЕ бинарное, а КОРНЕВОЕ дерево. Забудь все то, что я предлагал выше, то было для бинарных (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))