Левопрошитое дерево, проблемы Опции

[Jill]

Основной принцип: левый - потомок, правый - брат.
Описание дерева:

 type
    PTree=^TTree;
    TTree=record
      LL:PTree;    {левый указатель - на потомка если True, на предка если False}
      RL:PTree;    {правый указатель - на братьев}
      Key:string;  {ключ}
      Sign:boolean; {признак существования потомков}
    end; 

Если вершины нет, то создаем ее:

 if root=NIL then begin
    new(root);
    root^.LL:=root;   {сам на себя - предков нет}
    root^.RL:=NIL;    {нет братьев}
    root^.Key:='root';
    root^.Sign:=false; {нет потомков}

Добавление... Вроде существует два варианта - либо это первый потомок, либо нет. Не выходит реализовать это условие

 procedure AddElem(chto:string; kuda:PTree);
begin
    new(node);
    if kuda^.Sign=false then begin
      kuda^.LL:=node;    {на сына }
      kuda^.Sign:=true;  {у kuda появился потомок}
      node^.RL:=NIL;     {у node нет братьев}
      node^.LL:=kuda;    {на отца}
      node^.Key:=chto;
      node^.Sign:=false;  {у node нет потомков}
      end
    else begin  
      node:=kuda^.LL;    {находим первого сына}
      while node^.RL<>NIL do
        begin node:=node^.RL; end;  {продвигаемся по правой ветви}
        node^.RL:=NIL;
        node^.LL:=kuda;
        node^.Key:=chto;
        node^.Sign:=false;  
      end;
end;

.
Подскажите, плз, как с этим разобраться...

Сообщение отредактировано: volvo - 3.11.2006 19:49

[volvo]

Смотри, как я попробовал бы сделать:

type
  PTree=^TTree;
  TTree=record
    LL: PTree;
    RL: PTree;
    Key:string;
    Sign:boolean;
  end;

procedure Create(var root: PTree);
begin
  if root = nil then begin
    new(root);
    with root^ do begin
      LL := nil;     { <-- нет родителя - зачем присваивать себя? Работай с Nil }
      RL := nil;
      Key := 'root';
      Sign := false; { <-- нет потомков }
    end;
  end;
end;

{ Здесь: kuda описывается, как Var параметр, т.к. внутри процедуры он изменяется }
procedure AddElem(chto: string; var kuda: PTree);
var p, node: PTree;
begin
  new(node); { <-- Забрали память под новый элемент }
  if kuda^.Sign = false then begin
    { Если у элемента, к которому надо добавить новый, нет потомков }

    node^.RL := NIL; { у только что созданного элемента в любом случае нет братьев }
    node^.LL := kuda; { заполняем поле предка }
    node^.Key:=chto;
    node^.Sign:=false; { потомков у нового элемента тоже нет }

    kuda^.LL := node; { а вот у kuda появился потомок: здесь запоминаем его адрес }
    kuda^.Sign:=true; { и устанавливаем признак существования потомка }
  end
  else begin
    {
      В этом случае - у элемента, которому надо добавить новый
      уже есть потомки, так что добавляемых элемент будет братом
      последнего из них
    }

    { ищем этого брата, для чего используем новую переменную P }
    p := kuda^.LL; { это первый, "старший" из братьев }
    while p^.RL <> nil do
      p := p^.RL;
    { теперь в P хранится адрес "младшего" брата, к нему добавим еще одного }

    node^.RL:=NIL; { "младших братьев" пока нет }
    node^.LL:=kuda; { устанавливаем предка }
    node^.Key:=chto; 
    node^.Sign:=false; { потомков, естественно, тоже пока нет }

    p^.RL := node; { а вот теперь изменяем RL у БЫВШЕГО "младшего" брата }
  end;
end;

[Jill]

Еще раз спасибо за подробные комменты

Дописала пару процедур обработки - поиска и изменения элемента. Вроде работает, но затыкается при попытке пройтись "в глубину". Не могу понять, в чем дело...

function FindNode(T:PTree;ToFind:string):PTree;
begin
    If T=NIL Then Exit;
    if T^.Key=ToFind then begin FindNode:=T; exit end
      else FindNode:=NIL;
    if T^.Sign then FindNode(T^.LL,ToFind);
    if T^.RL<>NIL then FindNode(T^.RL,ToFind);
end;

procedure ChangeNode(p:PTree;ToChange:string);
var pp: PTree;
  begin
    if FindNode(p,ToChange)<>NIL then begin
    pp:=FindNode(p,ToChange);
    pp^.Key:='node7'; end
end;

Процедура вывода вроде без ошибок:

Procedure PrintDown(T:PTree;st:string);
begin
   If T = nil Then Exit;
   writeln(st+T^.key);
   if T^.Sign then PrintDown(T^.LL,St+st);
   if T^.RL<>NIL then PrintDown(T^.RL,St);
end;

Сообщение отредактировано: volvo - 3.11.2006 19:49