Бинарнoe деревo, удаление бинарного дерева Опции

[Трисемёрки]

Уважаемые господа программисты! Срочно нужна помощь в проверке правильности процедуры удаления бинарного дерева:

М

Пожалуйста, используй теги

Program Vedomost;
Uses
   Crt;
Type
   AdrText=^Anketa;
   Anketa=record
   Fio: string[70];
   Work: string[70];
   Adres: string[70];
   end;

   Adrzv=^Zveno;
   Zveno=record
   Key: word;
   Lev, Prav: Adrzv;
   Adr: AdrText
   end;

var
   s: word;
   d, g, f: string[70];
   a: Adrzv;
   j: AdrText;

Procedure Zanesenie;
begin
   write('Vvedite tabelnii nomer rabotyschego: ');
   readln(s);
   write('Vvedite fameliu, imia, otchestvo rabochego: ');
   readln(d);
   write('Vvedite mesto raboti, spetsialnost: ');
   readln(f);
   write('Vvedite domashnii adres rabotauschego: ');
   readln(g);
end;

Procedure SozdanieTree(var a: Adrzv; s: word; d, f, g: string);
var
   z: Adrzv;
   j: AdrText;
begin
   if a=Nil then
   begin
      New(j);
   	j^.Fio:= d;
     	j^.Work:= f;
     	j^.Adres:= g;

        New (z);
        z^.Key:= s;
   	z^.Lev:= Nil;
   	z^.Prav:= Nil;
        z^.Adr:=j;
  	a:=z;
   end
   else
   begin
   if a^.Key>s then
      SozdanieTree(a^.Lev, s, d, f, g)
    else
      SozdanieTree(a^.Prav, s, d, f, g);
   end;
end;

Procedure DelVedomost(var a:Adrzv);
begin
    if a=Nil then
    exit;
    DelVedomost(a^.Lev);
    DelVedomost(a^.Prav);
    dispose(Adr);
    Adr:=Nil; 
    dispose(a);
    a:=Nil;
end;

Вопрос: правильно ли проведена очистка памяти (память должна возвращаться в кучу перед завершением работы программы)? Возникает ошибка при выполнении удаления адреса a^.Adr.

Сообщение отредактировано: klem4 - 17.04.2008 12:14

[volvo]

Вопрос: правильно ли проведена очистка памяти (память должна возвращаться в кучу перед завершением работы программы)?

Ответ - да... Во всяком случае FPC утечек в "куче" не показывает, возвращается вся выделенная память.

Но все-таки:

Procedure DelVedomost(var a:Adrzv);
begin
if a=Nil then
exit;
DelVedomost(a^.Lev);
DelVedomost(a^.Prav);
dispose(a^.Adr); { <--- }
a^.Adr:=Nil; { <--- }
dispose(a);
a:=Nil;
end;

Возникает ошибка при выполнении удаления адреса a^.Adr.

Какая ошибка? Мне ничего не выдало... Показывай, как создаешь дерево (в смысле, вызов SozdanieTree из основной программы...)

Сообщение отредактировано: volvo - 17.04.2008 11:22

[Трисемёрки]

Ответ - да... Во всяком случае FPC утечек в "куче" не показывает, возвращается вся выделенная память.

Но все-таки:

Procedure DelVedomost(var a:Adrzv);
begin
if a=Nil then
exit;
DelVedomost(a^.Lev);
DelVedomost(a^.Prav);
dispose(a^.Adr); { <--- }
a^.Adr:=Nil; { <--- }
dispose(a);
a:=Nil;
end;

Какая ошибка? Мне ничего не выдало... Показывай, как создаешь дерево (в смысле, вызов SozdanieTree из основной программы...)

Возможно ошибка есть при записи или чтения из файла, поэтому вся программа:

Program Vedomost;
Uses
   Crt;
Type

   AdrText=^Anketa;
   Anketa=record
   Fio: string[70];
   Work: string[70];
   Adres: string[70];
   end;


   Adrzv=^Zveno;
   Zveno=record
   Key: word;
   Lev, Prav: Adrzv;
   Adr: AdrText
   end;

   Tabl=record
   Key:word;
   Fio: string[70];
   Work: string[70];
   Adres: string[70]
   end;

var
   i, m, q: byte;
s, x: word;
   d, g, f: string[70];
a, Tree: Adrzv;
   j: AdrText;

   W: File of Tabl;
   Wzveno: Tabl;

Procedure Pravila;
begin
   write('--------------------------------------------------------------------------------');
	writeln('Dlia povtornogo oznakomlenia s pravilami nazmite 11: ');
	writeln('Dlia formirovania dereva nazmite 1: ');
	writeln('Dlia priamogo vivoda spiska na ekran nazmite 2: ');
   writeln('Dlia obratnogo vivoda spiska na ekran nazmite 3: ');
	writeln('Dlia simmetrichnogo vivoda spiska na ekran nazmite 4: ');
	writeln('Dlia dobavlenia elementa v spisok nazmite 5: ');
	writeln('Dlia ydalenia elementa iz spiska nazmite 6: ');
	writeln('Dlia poisca elementa nazmite 7: ');
	writeln('Dlia zapis v fail nazmite 8: ');
   writeln('Dlia vivoda iz faila nazmite 9: ');
	writeln('Dlia vixoda iz programmi nazmite 0: ');
	write('--------------------------------------------------------------------------------');
end;

Procedure Zanesenie;
begin
   write('Vvedite tabelnii nomer rabotyschego: ');
   readln(s);
	write('Vvedite fameliu, imia, otchestvo rabochego: ');
   readln(d);
   write('Vvedite mesto raboti, spetsialnost: ');
   readln(f);
   write('Vvedite domashnii adres rabotauschego: ');
   readln(g);
end;

Procedure SozdanieTree(var a: Adrzv; s: word; d, f, g: string);
var
   z: Adrzv;
   j: AdrText;
begin
   if a=Nil then
   begin
      New(j);
   	j^.Fio:= d;
     	j^.Work:= f;
     	j^.Adres:= g;

      New (z);
      z^.Key:= s;
   	z^.Lev:= Nil;
   	z^.Prav:= Nil;
      z^.Adr:=j;
  	   a:=z;
   end
	else
	begin
   	if a^.Key>s then
         SozdanieTree(a^.Lev, s, d, f, g)
      else
         SozdanieTree(a^.Prav, s, d, f, g);
   end;
end;

Function Proverka(a: Adrzv): boolean;
begin
if a=Nil then
   Proverka:=false
else
   Proverka:=true;
end;

Procedure PrintPriam(a: Adrzv);
var   Adr: AdrText;
begin
if a<>Nil then
begin
write('--------------------------------------------------------------------------------');
Writeln('Tabelnii nomer:',a^.Key,'    FIO: ', a^.Adr^.Fio);
{Writeln('FIO: ', a^.Adr^.Fio); }
writeln('Work: ', a^.Adr^.Work,'   Adres: ', a^.Adr^.Adres);
{writeln('Adres: ', a^.Adr^.Adres);}
PrintPriam(a^.Lev);
PrintPriam(a^.Prav);
end;
end;

Procedure PrintObratn(a: Adrzv);
var   Adr: AdrText;
begin
if a<>Nil then
begin
PrintObratn(a^.Lev);
PrintObratn(a^.Prav);
write('--------------------------------------------------------------------------------');
Writeln('Tabelnii nomer:',a^.Key);
Writeln('FIO: ', a^.Adr^.Fio);
writeln('Work: ', a^.Adr^.Work);
writeln('Adres: ', a^.Adr^.Adres);
end;
end;

Procedure PrintSimmetr(a: Adrzv);
var   Adr: AdrText;
begin
if a<>Nil then
begin
PrintSimmetr(a^.Lev);
write('--------------------------------------------------------------------------------');
Writeln('Tabelnii nomer:',a^.Key);
Writeln('FIO: ', a^.Adr^.Fio);
writeln('Work: ', a^.Adr^.Work);
writeln('Adres: ', a^.Adr^.Adres);
PrintSimmetr(a^.Prav);
end;
end;

Function FindElement(var a: Adrzv; s: word):Adrzv;
begin
   if a=Nil then
   FindElement:=Nil
   else
   begin
	if s=a^.Key then
	FindElement:=a
	else
	if s<a^.Key then FindElement:=FindElement(a^.Lev, s)
	else
	FindElement:=FindElement(a^.Prav, s);
end;
end;


Procedure PrintElement(FindElement: Adrzv);
begin

if FindElement=Nil then
	writeln('Rabotauschego c takim tabelnim nomerom net.')
else
begin
write('--------------------------------------------------------------------------------');
Writeln('Tabelnii nomer: ',FindElement^.Key);
Writeln('FIO: ', FindElement^.Adr^.Fio);
writeln('Work: ', FindElement^.Adr^.Work);
writeln('Adres: ', FindElement^.Adr^.Adres);
write('--------------------------------------------------------------------------------');
end;
end;


Procedure DelElement1(var a: Adrzv; S: word);
var
	Q:Adrzv;

Procedure Ud(var E: Adrzv);
begin
if E^.Prav=Nil then
begin
Q^.Key:=E^.Key;
Q^.Adr:=E^.Adr;
Q:=E;
E:=Q^.Lev;
dispose(Q);
End
else
Ud(E^.Prav);
end;

begin
   if a=Nil then
      writeln('Rabotauschego c takim tabelnim nomerom net.')
   else
   begin
	   if s<a^.Key then
         DelElement1(a^.Lev, s)
	   else
         if s>a^.Key  then
            DelElement1(a^.Prav, s)
         else
         begin
            if (a^.Lev=Nil) and (a^.Prav<>Nil) then
               begin
               Q:=a;
	            a:=a^.Prav;

               dispose(Q);
               end
            else

            if (a^.Lev<>Nil) and (a^.Prav=Nil) then
               begin
   				Q:=a;
  				   a:=a^.Lev;

   				dispose(Q);
   				end
            else

            if (a^.Lev=Nil) and (a^.Prav=Nil) then
               begin


               dispose(a);
               a:=Nil;


               end
             else

            if (a^.Lev<>Nil) and (a^.Prav<>Nil) then
               begin
               Q:=a;
               Ud(Q^.Lev);
               end;
			END;
	end;
end;


Procedure Prisvoenie(var a:Adrzv);
var
	Adr: AdrText;
begin
   if a<>Nil then
	begin
	Wzveno.Key:=a^.Key;
   Wzveno.FIO:=a^.Adr^.Fio;
   Wzveno.Work:=a^.Adr^.Work;
   Wzveno.Adres:=a^.Adr^.Adres;
   Write(W, Wzveno);
   Prisvoenie(a^.Lev);
   Prisvoenie(a^.Prav);
   end;
end;

Procedure Infail(var a:Adrzv);
var
	Adr: AdrText;
begin
	assign(W,'Tree.Pas');
	rewrite(W);
   Prisvoenie(a);
   close(W);
	writeln('Cpisok yspeshno soxranen');
end;

Procedure Izfail(var a: Adrzv);
begin
	Assign(W,'Tree.PAS');
	{$I-} Reset(W); {$I+}
	if ioresult<>0 then
		writeln('Fail ne naiden')
	else
	begin
		if eof(W) then
      writeln('Fail pust')
	   else
	   begin
      a:=Nil;
		repeat
			read(W,Wzveno);
      SozdanieTree(a, Wzveno.Key, Wzveno.FIO, Wzveno.Work, Wzveno.Adres);
		until eof(W);
		end;
		close(W);
	end;
end;

Procedure DelVedomost(var a:Adrzv);
begin
    if a=Nil then
    exit;
   DelVedomost(a^.Lev);
   DelVedomost(a^.Prav);
    dispose(a^.Adr);
    a^.Adr:=Nil;
   dispose(a);
   a:=Nil;
end;

begin
   ClrScr;
   writeln('Vnimatelno izychite i zapomnite dannyy informatiy');
   Pravila;
   repeat
   write('Vvedite nomer komandi: ');
   readln(m);

	case m of
      11: Pravila;
		1: begin
         DelVedomost(Tree);

         Tree:=Nil;
         writeln('Vvedite kollichestvo chelovek: ');
         readln(q);
         for i:=1 to q do
         begin
            Zanesenie;
            SozdanieTree (Tree, s, d, f, g);
         end;
         end;
      2: begin
			if Proverka(Tree) then
            begin
            PrintPriam(Tree);
            write('--------------------------------------------------------------------------------');
            end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      3: begin
			if Proverka(Tree) then
            begin
            PrintObratn(Tree);
            write('--------------------------------------------------------------------------------');
            end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      4: begin
			if Proverka(Tree) then
            begin
            PrintSimmetr(Tree);
            write('--------------------------------------------------------------------------------');
            end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      5: begin
         if Proverka(Tree) then
            begin
          write('Vvedite dobavliaemoe kollichestvo chelovek: ');
         readln(q);
         for i:=1 to q do
         begin
         Zanesenie;
         SozdanieTree (Tree, s, d, f, g);
         end;
         end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      6: begin
         if Proverka(Tree) then
         begin
			write('Vvedite tabelnii nomer rabochego: ' );
         read(s);
         PrintElement(FindElement(Tree, s));
			end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      7: begin
            if Proverka(Tree) then
            begin
			      write('Vvedite tabelnii nomer rabochego: ' );
               read(s);

               DelElement1(Tree, S);

         if Proverka(Tree) then
            begin
            writeln('Izmenennii spisok:');
            PrintPriam(Tree);
            write('--------------------------------------------------------------------------------');
            end
         else
         writeln('Oshibka! Spiska ne suschestvuet.');

         END;
         end;
      8: begin
         if Proverka(Tree) then
         Infail(Tree)
         else
         writeln('Oshibka! Spiska ne suschestvuet.');
         end;
      9: begin
         DelVedomost(Tree);
         Izfail(Tree);
         PrintPriam(Tree);
         write('--------------------------------------------------------------------------------');
         end;

      0: begin
          DelVedomost(Tree);
          exit;
          end;

      end;
   until m=11;
   readln
end.

[volvo]

Опять-таки никаких ошибок не обнаружено... В какой последовательности и что ты делаешь, когда у тебя выскакивает ошибка (я больше про то, КАКАЯ ошибка спрашивать не буду: не хочешь отвечать - дело твое, программа нужна ТЕБЕ в конце концов, мне по барабану, сколько времени ты будешь ошибку искать, если не хочешь чтоб тебе помогли...)

У меня вот что было:

Vnimatelno izychite i zapomnite dannyy informatiy
Dlia povtornogo oznakomlenia s pravilami nazmite 11: ---------------------------
Dlia formirovania dereva nazmite 1:
Dlia priamogo vivoda spiska na ekran nazmite 2:
Dlia obratnogo vivoda spiska na ekran nazmite 3:
Dlia simmetrichnogo vivoda spiska na ekran nazmite 4:
Dlia dobavlenia elementa v spisok nazmite 5:
Dlia ydalenia elementa iz spiska nazmite 6:
Dlia poisca elementa nazmite 7:
Dlia zapis v fail nazmite 8:
Dlia vivoda iz faila nazmite 9:
Dlia vixoda iz programmi nazmite 0:
Vvedite nomer komandi: 1--------------------------------------------------------
Vvedite kollichestvo chelovek:
2
Vvedite tabelnii nomer rabotyschego: 23
Vvedite fameliu, imia, otchestvo rabochego:
Vvedite mesto raboti, spetsialnost: dsfgdsfg
Vvedite domashnii adres rabotauschego: dfgg
Vvedite tabelnii nomer rabotyschego: 45
Vvedite fameliu, imia, otchestvo rabochego: dfgsdfg
Vvedite mesto raboti, spetsialnost: sdfgdfgg
Vvedite domashnii adres rabotauschego: ffggg
Vvedite nomer komandi: 2
Tabelnii nomer:23 FIO: ------------------------------------------------------
Work: dsfgdsfg Adres: dfgg
Tabelnii nomer:45 FIO: dfgsdfg-----------------------------------------------
Work: sdfgdfgg Adres: ffggg
Vvedite nomer komandi: 8--------------------------------------------------------
Cpisok yspeshno soxranen
Vvedite nomer komandi: 9
Tabelnii nomer:23 FIO: ------------------------------------------------------
Work: dsfgdsfg Adres: dfgg
Tabelnii nomer:45 FIO: dfgsdfg-----------------------------------------------
Work: sdfgdfgg Adres: ffggg
Vvedite nomer komandi: 0--------------------------------------------------------
Heap dump by heaptrc unit
18 memory blocks allocated : 1070/1120
18 memory blocks freed : 1070/1120
0 unfreed memory blocks : 0
True heap size : 163840 (144 used in System startup)
True free heap : 163696

[Трисемёрки]

Возможно, я плохо разбираюсь в теории динамических данных, но у меня в окне Watch при выходе из программы "не обнуляются" Tree^. Adr; Tree^.Prav; Tree^.Lev.

[volvo]

А должны? То, что ты видишь - это уже "левые" значения, мусор, совершенно не то, что там было во время работы программы, если поставишь точку останова в DelVedomost - можешь в этом убедиться... У тебя ж сам Tree об-NIL-ен, а ты хочешь увидеть Tree^.{что-то}? Это называется разыменование нулевого указателя, что категорически запрещено.

Более новые компиляторы просто не показывают Tree^.Adr после выполнения Dispose(a), говорят "Cannot access memory at address $0"

Кстати, еще один способ проверить, вся ли память высвобождается - это после вызова Pravila напечатать

Writeln(MemAvail);

, и то же самое сделать после освобождения памяти перед выходом из программы. Значения должны быть одинаковы... Только что проверил - и там и там 528032, все в порядке...

[Трисемёрки]

Большое спасибо volvo