1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
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
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;
Бинарнoe деревo, удаление бинарного дерева
17.04.2008 11:09
0 
Трисемёрки Бинарнoe деревo 17.04.2008 11:09
