Бинарное дерево-уход в бесконечный циклр, Stack overflow error Опции

[Pessimist]

Англо-русский словарь построен как бинарный список (двоичное
дерево).
Каждая компонента содержит английское слово, соответствующее
ему русское слово и счетчик количества обращений к данной компонен-
те.
Первоначально бинарный список был сформирован согласно английс-
кому алфавиту. В процессе эксплуатации словаря при каждом обращении
к компоненте в счетчик обращений добавлялась единица.

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

-производит распечатку исходного и нового словарей.

Указание: использовать динамические структуры.


КОД ПРОГРАММЫ:

program dynamic;
uses crt;
type rec = record
          num : word;
          eng : string;
          rus : string;
     end;
     pnode = ^node;
     node = record
         data : rec;
         left : pnode;
         right: pnode;
     end;
var root,rootnew  :pnode;
    key   :string;
    option,temp:word;
    rec1:rec;
F,Fresult:text;


procedure print_tree(p:pnode);
begin
     if p=nil then exit;
     with p^ do begin
          print_tree(right);
          write(data.eng,'    ', data.rus,'    ', data.num);
          writeln;
          write(Fresult, data.eng,'    ', data.rus,'    ', data.num);
          writeln(Fresult);
          print_tree(left);
     end
end;

function find(root:pnode; key:string; var p,parent:pnode): boolean;
begin
     p:=root;
     while p<>nil do begin
           if key=p^.data.eng then
              begin find:=true; exit end;
           parent:=p;
           if key< p^.data.eng
              then p:=p^.left
              else p:=p^.right;
           end;
           find:=false;
end;

procedure insert(var root : pnode; rec1:rec);
var p1,parent : pnode;
begin
     if find(root, rec1.eng, p1,parent) then begin
     writeln('takoi element uzhe est'); exit; end;
     new(p1);
     p1^.data :=rec1;
     p1^.left :=nil;
     p1^.right:=nil;
     if root = nil then root :=p1
     else
         if rec1.eng < parent^.data.eng
         then parent^.left :=p1
         else parent^.right :=p1;
end;

procedure del(var root:pnode;key:string);
var p      :pnode;
    parent :pnode;
    y      :pnode;

function descent(p:pnode):pnode;
var y:pnode;
    prev:pnode;
begin
     y:=p^.right;
     if y^.left = nil then y^.left:=p^.left
     else begin
          repeat
                prev:=y;y:=y^.left;
          until y^.left =nil;
          y^.left:=p^.left;
          prev^.left:=y^.right;
          y^.right:=p^.right;
     end;
     descent:=y;
end;

begin
     if not find(root, key,p,parent) then begin
        writeln('takogo el-ta net'); exit; end;
     if      p^.left = nil then y:=p^.right
     else if p^.right = nil then y:=p^.left
     else    y:=descent(p);
     if p=root then root:=y
     else
         if key < parent^.data.eng
            then parent^.left:=y
            else parent^.right:=y;;
     dispose(p);
end;

{-------------------------------------}
function max(p:pnode) : word;
var m:word;
begin
if p=nil then begin max:=0; exit end;
if ( max(p^.left) <= max(p^.right)) then
m:=max(p^.right)
else m:=max(p^.left);
if p^.data.num>m then max:=p^.data.num
else max:=m;
end;
{-------------------------------------}
function findmax(p:pnode;max:word) : pnode;
begin
     if p=nil then exit;
     with p^ do begin
     if findmax(left,max) <> nil then
     begin findmax:=findmax(left,max); exit end
     else if findmax(right,max) <>nil then
     begin findmax:=findmax(right,max); exit end
     else if data.num=max then
     begin findmax:=p; exit end
     else findmax:= nil;
     end;
end;
{-------------------------------------}

procedure move(p,pnew:pnode);
var m:word;
    p2:pnode;
    i:integer;
begin
if p=nil then exit;
for i:=1 to 3 do
begin
m:=max(p);
p2:=findmax(p,m);
writeln(p2^.data.eng);
insert(pnew,p2^.data);
del(p,p2^.data.eng);
move(p,pnew);
end;
end;




begin
root:=nil;
rootnew:=nil;
Assign(F, '15_10_in.txt');
reset(F);
   while eof(F)=false do begin
         with rec1 do begin
         readln(F, num);
         readln(F, eng);
         readln(F, rus);
         end;
         insert(root, rec1)

   end;
close(F);
assign(Fresult, '15_10_out.txt');
rewrite(Fresult);
print_tree(root);
move(root,rootnew);
close(Fresult)
end.

при попытке компиляции выдает Stack overflow error сам ошибку найти не смог, а прогу позарез к утру сделать нуна.

Очччень нуна помощщщьь

Тегами пользуйся, без них программа нечитаема абсолютно

Сообщение отредактировано: volvo - 22.01.2009 3:27

[volvo]

У тебя в программе 2 проблемы:
1) не совсем корректно находится указатель на элемент, содержащий заданное тобой значение (функция findmax)... Я бы ее переписал вот так:

function findmax(p:pnode; max:word) : pnode;
begin
     if p=nil then findmax:=nil
     else
       if p^.data.num = max then findmax := p
       else
         if max < p^.data.num then findmax := findmax(p^.left, max)
         else findmax := findmax(p^.right, max);
end;

2) более серьезная проблема: на определенном этапе у тебя происходит попытка разыменования nil-а, но ты этого не замечаешь. Смотри:

procedure move(p,pnew:pnode);
var m:word;
    p2:pnode;
    i:integer;
begin
  if p=nil then exit;
  for i:=1 to 3 do
  begin
    m:=max(p); { <--- допустим, ты уже выбрал все из словаря, p = nil }
    p2:=findmax(p,m); { <--- Тогда и здесь будет p2 = nil }
    writeln(p2^.data.eng); { <--- Стоп!!! }
    insert(pnew,p2^.data);
    del(p,p2^.data.eng);
    move(p,pnew);
  end;
end;

Тебе ж все равно надо работать до исчерпания исходного словаря? Тогда каким боком там рекурсия: Удаляй по одному элементу из дерева, пока его корень не станет нулевым:

procedure move(p,pnew:pnode);
var m:word;
    p2:pnode;
begin
repeat
  m:=max(p);
  p2:=findmax(p,m);
  if p <> nil then begin
    writeln(p2^.data.eng);
    insert(pnew,p2^.data);
    del(p,p2^.data.eng);
  end;
  until p = nil;
end;

Это все при условии, что удаление/добавление работают правильно, я не проверял их реализацию... Но теперь ты знаешь, в чем проблема и справишься (надеюсь) дальше самостоятельно...