Версия для печати темы

Автор: Vandrouny 14.05.2009 23:22

Доброго времени суток!
Пишу вот лабу про деревья.
Суть её такова: построить дерево и реализовать прямой его обход (там ещё обратный и симметричный, но пока хоть бы прямой). Но не простой обход, а полный: показать, какие вершины последовательно анализируются.
Т.е., если в дерево вогнать последовательно 8,6,4,1,2,3,15,11,13,9,5 - он вывел
8-6-4-1-0-1-2-0-2-3-0-3-0-3-2-1-4-5-0-5... (0 - значит, пустой лист найден)
Суть проблемы: когда надо возвращаться, моя программа не отображает этого. Т.е, при этом дереве она пропускает символы:
8-6-4-1-0-1-2-0-2-3-0-3-0-4-5-0-5... (нету этого возврата 3-2-1)
Помогите, пожалуйста!

program tree;
uses crt;
Type tekst = integer;
adrzv = ^zveno;
zveno = record
kl:integer;
inf:tekst;
lev,prav:adrzv;
end;

var
t:adrzv;
n,c,f,i,y,otvet:integer;
mn: set of 1..100;
Procedure add(var S: adrzv; k: integer); {добавление элементов}
Begin
If s = nil
 then
   Begin
   New(s);
   s^.kl:=k;
   s^.lev:=nil;
   s^.prav:=nil;
   End
 else
If k < s^.kl then add(s^.lev, k);
If k > s^.kl then add(s^.prav, k);
End;



Procedure show(var s:adrzv; h: integer);  {вывод дерева}
Var i: integer;
Begin
If s <> nil then
   Begin
   show(s^.prav, h + 4);
   For i:=1 to h do write(' ');
   Writeln(s^.kl);
   show(s^.lev, h + 4);
   End
End;

Procedure direct(var s:adrzv); {процедура обхода}
Var i: integer;
Begin
   if s= nil then write('0 ')
   else
   begin
   if s^.kl in mn then write(s^.kl,' ')
   else begin mn:=mn+[s^.kl]; write(s^.kl,'+ '); end;
   direct(s^.lev);
   if s^.kl in mn then write(s^.kl,' ')
   else begin mn:=mn+[s^.kl]; write(s^.kl,'+ '); end;
   direct(s^.prav);
   end;
End;

begin clrscr;
writeln('random or not?(1/2)');
read(otvet);
case otvet of
1: begin
   randomize;
   for i:=1 to 10 do add(t,random(20));
   end;

2: begin
   writeln('enter number of elements');
   readln(n);
   writeln('enter elements');
   for i:=1 to n do
     begin
     read©;
     add(t,c);
     end;
   end;
end;
show(t,c);
direct(t);
readkey;
end.

Автор: volvo 15.05.2009 3:41

Ты ж не просишь ,вот и не отображает... Я вот так попросил:

procedure direct(var s: adrzv);
begin
  if s = nil then write(0, ' ')
  else begin
    if s^.kl in mn then write(s^.kl,' ')
    else begin mn:=mn+[s^.kl]; write(s^.kl,'+ '); end;
    direct(s^.lev);

    write(s^.kl, ' ');

    direct(s^.prav);
    if s^.kl in mn then write(s^.kl,' ')
    else begin mn:=mn+[s^.kl]; write(s^.kl,'+ '); end;
  end;
end;

Автор: Vandrouny 17.05.2009 20:13

Спасибо, помогло!
Двигаюсь дальше, возникла ещё одна проблема: в обратном обходе непонятно, как правильно реализовать пометку плюсом элемента, который обрабатывается (т.е. если он просто проходится - без плюса, а если обрабатывается - с плюсом).

Procedure back(var s:adrzv);
Var i: integer;
Begin
   if s= nil then write(0,' ')
   else
   begin
   write(s^.kl,' ');
   direct(s^.lev);
   write(s^.kl,' ');
   direct(s^.prav);
   if s^.kl in mn then write(s^.kl,' ')
   else begin mn:=mn+[s^.kl]; write(s^.kl,'+ '); end;
   end;
End;

Добавлено через 15 мин.
Ой, всё отменяется, я дурень несусветный)))
В процедуре back использую рекурсивно процедуру direct)

Автор: Vandrouny 19.05.2009 0:07

А вот на последнем пункте задания совсем что-то заступорился...
Надо сделать симметричную правую прошивку дерева.
Как сделать - не представляю...
Помогите, пожалуйста...

Автор: volvo 19.05.2009 1:11

В присоединенном документе приведен псевдокод прошивки дерева...


Прикрепленные файлы
 notes2_trees_p17_22.pdf ( 318.14 килобайт ) Кол-во скачиваний: 2506

Автор: Vandrouny 19.05.2009 1:39

что-то я ничего не втыкаю...
нет ли ещё какого-нибудь примера?
и желательно на пальцах \ по-русски?

Автор: volvo 19.05.2009 3:04

По-русски... Не встречал. Разве что "Кнут, Дональд: Искусство программирования. Том 1 - Основные алгоритмы." открываешь на стр. 353 (раздел 2.3.1) и смотришь, там есть информация по прошитым деревьям.