Помощь - Поиск - Пользователи - Календарь
Полная версия: Левопрошитое дерево
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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; {нет потомков}

Добавление... Вроде существует два варианта - либо это первый потомок, либо нет. Не выходит реализовать это условие unsure.gif
 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
Смотри, как я попробовал бы сделать:
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
Еще раз спасибо за подробные комменты smile.gif

Дописала пару процедур обработки - поиска и изменения элемента. Вроде работает, но затыкается при попытке пройтись "в глубину". Не могу понять, в чем дело... unsure.gif
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
Jill, ты программку-то свою приведи, как именно ты пытаешься работать с этими процедурами/функциями?

(сразу, не проверяя, могу сказать, что функция FindNode не очень мне нравится, т.к. не в каждой точке выхода она возвращает значение, а это плохо)
Jill
Дело в том, что мне необходимо оформить работу в делфях. Как работают процедуры в паскальных набросках примитивны - просто вызов и что из этого получится. Функция FindNode необходима для поиска элемента, который надо изменить (ChangeNode) или для поиска элемента, подлежащего удалению.
Код вот (повторюсь, главная программа - примитивна - мне нужно понять):
" (Показать/Скрыть)
volvo
Как я и предполагал, функция FindNode оказалась проблемной... Я немного ее изменил, вот в таком виде она вроде работает:
function FindNode(T: PTree; ToFind: string): PTree;
var p: PTree;
begin
FindNode := nil;
if T = nil then exit;

if T^.Key = ToFind then begin
FindNode := T; exit
end;

if T^.Sign then begin

p := FindNode(T^.LL, ToFind);
FindNode := p;

if p <> nil then exit

end;

FindNode := FindNode(T^.RL, ToFind);
end;


Ну, и ChangeNode заодно тоже подправить (совершенно незачем вызывать одну и ту же функцию дважды. Это, кстати, в некоторых случаях может привести к ошибкам)...
procedure ChangeNode(p: PTree; ToChange: string);
var pp: PTree;
begin
pp := FindNode(p, ToChange);
if pp <> nil then begin
pp^.Key:='node7';
end
end;
Jill
Ок, с этим разобралась. Спасибо :-)
Очередные заковырки - удаление...
Удаление всего дерева расписала:
procedure DeleteTree(T:PTree);
Begin
If T=nil Then Exit;
if T^.Sign then DeleteTree(T^.LL);
if T^.RL<>NIL then DeleteTree(T^.RL);
Dispose(T);
end;

Удаление выбранного узла (при условии, что у него нет сыновей) попыталась, но не работает sad.gif Где неверно?
 procedure DeleteNode(T:PTree;ToDel:string);
var pred,posl,pp:PTree;
begin
pp:=FindNode(T,ToDel); {pp указывает на выбранный узел}
if pp<>NIL then begin {если узел найден, то...}
if (pp^.RL<>NIL)and(pp^.LL^.LL<>pp)then {если узел - "средний" брат}
begin
pred:=pp^.LL^.LL; {находим "старшего" брата найденного узла}
while pred^.RL<>pp do
pred:=pred^.RL; {продвигаемся по правой ветви пока не нашли предшествующий узел}
posl:=pp^.RL; {определяем последующий узел}
pred^.RL:=posl; {перераспределяем связи}
dispose(pp); {удаляем выбранный}
end
else
if pp^.RL=NIL then {если узел - "младший" брат}
dispose(pp)
else
if (pp^.RL<>NIL)and(pp^.LL^.LL=pp) then {если узел - "старший" брат}
begin
pred:=pp^.LL; {отец выбранного узла}
posl:=pp^.RL; {следующий за выбранным брат}
pred^.LL:=posl; {перераспределяем связи}
dispose(pp);
end;
end;
end;

И еще. Как связать эти две процедуры, чтобы удалить узел, у которого есть сыновья/поддеревья? Удалить вместе с ними? Как? Тут я вообще сориентироваться не могу unsure.gif
volvo
Jill, с удалением одного элемента у тебя проблема - дело в том, что если у узла есть потомок (Sign = True), то НИГДЕ не хранится адрес предка этого узла. Смотри сама: в RL хранится указатель на "братьев", а в LL - указатель на потомка. Как найти предка?

Единственное решение, которое будет работать и для Sign = True и для Sign = False: Проходить еще раз по всему дереву, и искать узел, содержимое RL (или LL при Sign=True) которого равняется адресу элемента, который ты нашла здесь:
  pp:=FindNode(T, ToDel);
только так ты можешь гарантированно найти предка PP.
Jill
Написала функцию поиска предыдущего элемента. Что-то длинноватая получилась, но работает:
 function FindPreceding(T,pp:PTree):PTree;   {pp - найденный узел}
var p:PTree;
begin
FindPreceding:=nil;
if T=nil then exit;
if T^.RL=pp then
begin
FindPreceding:=T; exit;
end;
if (T^.Sign) and (T^.LL=pp) then
begin
FindPreceding:=T; exit;
end;
if T^.Sign then
begin
p:=FindPreceding(T^.LL,pp);
FindPreceding:=p;
if p<>NIL then exit;
end;
if T^.RL<>NIL then
begin p:=FindPreceding(T^.RL,pp);
FindPreceding:=p;
if p<>NIL then exit;
end;
end;

Теперь удаление:
 procedure DeleteNode(T:PTree;ToDel:string);
var pred,posl,p:PTree;
begin
p:=FindNode(T,ToDel); {p указывает на выбранный узел}
if p<>NIL then begin {если узел найден, то...}

if p^.LL=NIL then
begin
DeleteTree(p); {найденный узел - корень дерева}
exit;
end;

pred:=FindPreceding(root,p);
if p^.Sign then {удаление поддерева без выбранного узла}
begin
posl:=p^.LL; {?как быть с левым указателем?}
DeleteTree(posl);
end;

if p^.RL=NIL then {если узел не имеет "младших" братьев}
begin
pred^.RL:=NIL;
dispose(p)
end
else
if p^.RL<>NIL then {если узел имеет "младшего" брата}
begin
if pred^.RL=p then {если предыдуший узел - "старший" брат}
begin
posl:=p^.RL;
pred^.RL:=posl;
dispose(p);
end;
if (pred^.Sign)and(pred^.LL=p) then {если предыдуший узел - отец}
begin
posl:=p^.RL;
pred^.LL:=posl;
dispose(p);
end;
end;
end;
end;

volvo
По просьбе Jill зашел в этот топик smile.gif , и сразу вопрос на засыпку: а почему именно левопрошитое дерево? Есть какие-то преимущества его перед правопрошитым? Или перед AVL? Кстати, та структура, которую ты привела, не имеет никаких преимуществ перед N-арным деревом (когда-то было написано мной и такое, могу покопаться и найти исходники), а вот мороки с ней сама видишь, насколько больше...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.