УДАЛЕНИЕ ВЕРШИНЫ ИЗ ДЕРЕВА. если у Д нет потомков , то ее просто удалить ;если у Д 1 потомок-поддерево, то Д удалить, а потомка переместить на то место ,где до этого была вершина Д; если у Д 2 потомка, то найти в левом потомке самую правую вершину (или в правом - самую левую) и заместить ею удаляемую вершину Д.Дано целочисленное бинарное дерево поиска, целое число Д.Удалить из дерева вершину, значение которой равно Д, или сообщить что такой вершины не существует .
вот уже какой день мучаюсь с этой программой, помогите исправить , где доделать, УМОЛЯЮ!!!!
Код: Выделить всё
Program Poisk;
Uses
Crt;
Type
Pt = ^Node;
Node = Record
Data : integer;
Left, Right : Pt;
End;
Procedure DelTree(x : integer; Var p : Pt);
Var
q : Pt;
Procedure D1(Var r : Pt);
Begin
if r^.Right <> Nil
then
d1(r^.Right)
else
begin
q^.Data := r^.Data;
q := r;
r := r^.Left;
Dispose(q);
end;
End;
Begin
if p=nil
then
writeln('Элемента с ключом ', x, 'в дереве нет.')
else
if x<p^.Data
then
DelTree(x, p^.Left)
else
if x>p^.Data
then
DelTree(x, p^.Right)
else
begin
q := p;
if q^.Right = Nil
then
begin
p := q^.Left;
dispose(q);
end
else
if q^.Left = Nil
then
begin
p := q^.Right;
dispose(q);
end
else
D1(q^.Left)
end;
End;
Type
Words = ^WordTree;
WordTree = record
Data : string;
k : integer;
Left, Right : Words;
end;
Var
n : integer;
kd : Words;
x : string;
f : text;
Procedure Tree(x : string; Var p : Words);
Begin
if p=nil
then
begin
new(p);
with p^ do
begin
k := 1;
Data := x;
Left := Nil;
Right := Nil;
end;
end
else
if x>p^.Data
then
Tree(x, p^.Left)
else
if x<p^.Data
then
Tree(x, p^.Right)
else
Inc(p^.k);
End;
Procedure PrintTree(t : Words; h : integer);
Var
i : integer;
Begin
if t <> Nil
then
with t^ do
begin
PrintTree(Left, h+1);
for i := 1 to h do
write(' ');
writeln(Data, ',(', k, ')');
PrintTree(Right, h+1);
end;
End;
Begin
ClrScr;
assign(f);
reset(f);
write('n=');
readln(n);
kd := Nil;
while n>0 do
begin
readln(f,x);
Tree(x, kd);
Dec(n);
end;
close(f);
DelTree(x,dl);
PrintTree(kd, 0);
readln;
End.