ПРОСТИТЕ)) ПОКА РЕДАКТИРОВАЛ ТЕМУ ЗАМЕТИЛ СВОЮ ОШИБКУ ТЕПЕРЬ РАБОТАЕТ.
Может кому то пригодиться процедура deleteTree5 которая удаляет узел с ключем равным параметру fio.[/b]
Я создал дерево процедурами создание первого узла и добавления нового узла. Каждый узел может иметь максимум два поддерева. Процедуру удаления ветви одноя я нашел реализованную:
Код
type name=string[20];
TNodeTree=^Node;
Node=record
FIO:name;
Date:TDateTime;
Status:name;
Left,
Right: TNodeTree;
end;
TNodeTree=^Node;
Node=record
FIO:name;
Date:TDateTime;
Status:name;
Left,
Right: TNodeTree;
end;
Код
procedure deleteTree5( var q: TNodeTree;x:name);
var p: TNodeTree;
procedure del(var c: TNodeTree);
begin
if c^.right <> nil then del(c^.right)
else begin
p^.FIO:=c^.FIO;
p:=c;
c:=c^.left;
end;
end;
begin {delete}
if q = nil then {writeln(" sym is not in tree") }
else if x < q^.fio then deleteTree5( q^.left,x)
else if x > q^.fio then deleteTree5( q^.right,x)
else begin
p:=q;
if p^.right = nil then q:=p^.left
else if p^.left = nil then q:=p^.right
else del(p^.left);
dispose(p);
end
end;
var p: TNodeTree;
procedure del(var c: TNodeTree);
begin
if c^.right <> nil then del(c^.right)
else begin
p^.FIO:=c^.FIO;
p:=c;
c:=c^.left;
end;
end;
begin {delete}
if q = nil then {writeln(" sym is not in tree") }
else if x < q^.fio then deleteTree5( q^.left,x)
else if x > q^.fio then deleteTree5( q^.right,x)
else begin
p:=q;
if p^.right = nil then q:=p^.left
else if p^.left = nil then q:=p^.right
else del(p^.left);
dispose(p);
end
end;
Она работает)
Я поместил ее в цыкл пока не удалены все узлы:
Код
while root<>nil do DeleteTree5(root, root.fio);
Но программа виснет если дерево содержит больше чем один узыл (