Закавыристая процедура, работа с деревьями Опции

[Clon]

Вот тут написал программу. Она создает деверо общего вида, добавляет к нему элементы, печатает его. Но вот главная процедура мне что-то не хочет даваться. Задача ее состоит в том, чтобы подсчитать число вершин дерева, степень которых совпадает со значением их элементов. Причем элементы типа Char. Я знаю есть такая функция ord, но как это вообще реализовать я не могу. Вот прога, помоги те если не трудно

Код

program lab22(input,output);
type tree = ^node;
   node      = record
           inf    : char;
           brat,son    : tree;
        end;    
var t            : tree;
   q,data,kuda,shto        : char;
   c,i            : integer;
b            : boolean;
procedure dop(var t : tree);
begin
   if t^.brat=nil then
   begin
      new(t^.brat);
      writeln('vvedi element');
      readln(t^.brat^.inf);
      t^.brat^.brat:=nil;
      t^.brat^.son:=nil;
   end
   else dop(t^.brat);
end;
procedure sozd(var t:tree;var data:char);
begin
   writeln('vvedite element');
   readln(data);
   new(t);
   t^.inf:=data;
   t^.brat:=nil;
   t^.son:=nil;
end;
procedure add(var t : tree; data:char);
begin
   if t^.inf<>kuda then
   begin
      if t^.son<>nil then add(t^.son,kuda);
      if t^.brat<>nil then add(t^.brat,kuda);
   end
   else
   begin
      if t^.son=nil then
      begin
     new(t^.son);
     write('vvedite element:');
     readln(t^.son^.inf);
     t^.son^.son:=nil;
     t^.son^.brat:=nil;
      end
      else dop(t^.son);
   end;
end;
procedure dobavlenie;
begin
   write('kuda postavit element?:');
   readln(kuda);
   add(t,kuda);
end;
procedure print(t:tree; var i:integer);
var j : integer;
begin
   write('':i,t^.inf);
   if t^.brat<>nil then
   begin
      print(t^.brat,i);
   end;
   if t^.son<>nil then
   begin
      writeln;
      print(t^.son,i);
   end;
   i:=i+1;
end;
begin
   while b<>true do
   begin
      writeln('      1 - Sozdanie');
      writeln('      2 - Dobavlenie elementa');
      writeln('      3 - Print');
      writeln('      4 - Udalenie');
      writeln('      5 - Exit');
      writeln('      6 - Active');
write('vvedite punkt menu:');
      readln(c);
      if c=1 then sozd(t,data);
      if c=2 then dobavlenie;
      if c=3 then print(t,i);
      writeln;
      writeln('hotite prodoljit?y/n');
      readln(q);
      if q='y' then b:=false;
      if q='n' then b:=true;
      if (q<>'y') and (q<>'n') then
      begin
     writeln('Tolko "n" ili "y"!');
     readln(q);
      end;
   end;
end.

[volvo]

подсчитать число вершин дерева, степень которых совпадает со значением их элементов.

Если ты имеешь в виду УРОВЕНЬ расположения элемента в дереве, то:

Procedure CountLevel(Level: integer; Root: Tree; Var n: integer);
Begin
  if Root <> Nil then begin
    if Ord(Root^.inf) = Level then Inc(n);
    CountLevel(Succ(Level), Root^.brat, n);
    CountLevel(Succ(Level), Root^.son, n);
  end;
End;
...
{ Вызов: }
n := 0;
CountLevel(0, t, n);
...

?

[Clon]

Ну, насколько я знаю, степенью вершины называется число исходящих из нее ветвей. То есть если число ветвей 5 и ord возвращает 5, то такая вершина засчитывается

[volvo]

Определение 2. Степенью вершины дерева называется число дуг, исходящих из нее.

У тебя по определению в бинарном дереве не может быть степени, равной 5, т. к. число исходящих дуг ограничено двумя.
Следовательно:

...
    if
      Ord(Root^.inf) =
      Byte(Root^.Brat <> nil) + Byte(Root^.Son <> nil) then Inc(n);
...

[Clon]

Но у меня дерево не бинарное, а общего вида

[volvo]

Это твое определение дерева?

type
  tree = ^node;
  node = record
    inf    : char;
    brat, son: tree; // Это - общего вида?
  end;

У тебя в приведенном фрагменте сколько может быть потомков МАКСИМУМ у вершины? Два, не так ли? Значит, бинарное дерево.

Дерево общего вида (с произвольным количеством потомков у каждой вершины) описывается по другому...

[Clon]

То есть в записи node задавать больше вершин? Ну а если мне понадобится десять вершин или двадцать, как это тогда описать?

[volvo]

Ясно. Я понял твою логику. У тебя Brat - это указатель НЕ на потомка, а на следующего потомка родителя, а вот Son - именно указатель на список потомков, так? Я просто всегда описываю поля так:

type
  ptree = ^tree;

  tree = record
    inf: char;
    next: ptree; // Соответствует твоему Brat
    child: ptree; // Соответствует твоему Son
  end;

Тогда нужная тебе процедура будет выглядеть приблизительно так:

procedure Count(root: ptree; var n: integer);
var
  p: ptree;
  X: integer;
begin
  if root <> nil then begin
    p := root^.child; // Будем работать с потомками данного узла

    X := 0; // Посчитаем их число
    while p <> nil do begin
      inc(X); p := p^.next;
    end;

    // Если условие выполняется - увеличить n
    if ord(root^.inf) = X then Inc(n);

    p := root.next; // А теперь запустим рекурсию для всех "братьев" ...
    while p <> nil do begin
      Count(p, n); p := p^.next;
    end;
    p := root.child; // ... и для всех потомков ТЕКУЩЕГО узла ...
    while p <> nil do begin
      Count(p, n); p := p^.next;
    end;

  end;
end;

// Пример вызова:
var
  root: ptree;
  n: integer;
begin
  root := nil;
  // ...
  // Заполнение дерева

  Count(root, n);
end.

Я надеюсь, ничего не перепутал, ибо лениво заполнять список и проверять правильность работы процедуры...

[Clon]

Странно, подогнал процедуру под свою прогу, но он мне ошибку выдает

Stack overflow error

Код

program lab22(input,output);
type tree = ^node;
   node      = record
           inf    : char;
           brat,son    : tree;
        end;
procedure Count(t: tree; var n: integer);
var
  p: tree;
  X: integer;
begin
  if t <> nil then begin
    p := t^.son;
    X := 0;
    while p <> nil do begin
      inc(X); p := p^.brat;
    end;
    if ord(t^.inf) = X then Inc(n);
    p :=t;
    while p <> nil do begin
      Count(p, n); p := p^.brat;
    end;
    p := t^.son;
    while p <> nil do begin
      Count(p, n); p := p^.brat;
    end;
   end;
end;
\\ ну и вызов соответственно
begin
       Count(t, n);
       writeln('kol-vo takih vershin:',n);
       end;

Сообщение отредактировано: Clon - 19.05.2006 18:14

[volvo]

Внимательно:

Код

    p :=t.brat; { <--- Здесь !!! }
    while p <> nil do begin
      Count(p, n); p := p^.brat;
    end;

[Clon]

Все, огромное спасибо, заработало.
Кстати, а где можно посмотреть процеруду удаление элемента? Я глянул в FAQ, но там только для двоичных деревьев.

[volvo]

Кстати, а где можно посмотреть процеруду удаление элемента? Я глянул в FAQ, но там только для двоичных деревьев.

Вот процедура удаления дерева общего вида:

{ Описание типа Tree }
type
  T = char;

  tree = ^node;
  node = record
    inf: T;
    brat, son: tree;
  end;
...
{ Процедура добавления осталась твоя... }

{ Удаление: }
procedure destroy(t: tree);
var p, pt: tree;
begin
  if t <> nil then begin
    p := t;
    while p <> nil do begin
      destroy(p^.son); pt := p;
      p := p^.brat;
      dispose(pt);
    end;
  end;
end;

...
{ Проверяем работу: }

{ В самом начале программы делаем : }
WriteLn(MemAvail); { Количество свободной памяти, запомни его !!! }
...
      write('vvedite punkt menu: '); readln©;
      case c of
        ...
        5: begin
          b := true;
          destroy(root^.son); dispose(root); { Удаляем все дерево и сам корень }
          writeln(memavail); { А вот это число должно совпадать с первым выведенным }
        end;
      end;
...

[Clon]

Ошибка. Указывает на

Код

dispose(pt);

и пишет

Invalid pointer operation

Сообщение отредактировано: Clon - 20.05.2006 20:43

[volvo]

Ну, не знаю. Я скопировал сюда из только что отработавшей программы... Никаких ошибок не показывает, все нормально работает... Хочешь - присоединю свой файл...

P.S. Проверяй... А мне надоело. Все время что-то у кого-то не работает, где-то сбоит... Теперь буду чисто теоретически отвечать, никакого кода больше не будет.

Сообщение отредактировано: volvo - 20.05.2006 20:53

[Clon]

Ладно, все равно спасибо. Вот только процедура эта, она удаляет все дерево или только указанный элемент? просто у меня она удаляет все кроме первого элемента.

Сообщение отредактировано: Clon - 20.05.2006 21:17