program lab10;
uses CRt;
type
data =record
nomer:integer;
F,I,O:string[15];
Ocenki:record
math,history,physyc:integer
end;end;
Treeprt=^tree;
tree=record
inf:data;
left,right:treeprt
end;
derevo = file of data;
var
top: treeprt;
z:data;
Level,key, n: integer;
i, number: integer;
tab: derevo;
function AddTree (top:treeprt; newnode:data):treeprt;
begin
if top=nil then
begin
new(top);
top^.inf:=newnode;
top^.left:=nil;
top^.right:=nil;
end
else
if top^.inf.ocenki.math>newnode.ocenki.math then
top^.left:=addTree(top^.left,newnode)
else
Top^.right:=addTree(top^.right,newnode);
addTree:= top;
end;
procedure OrgTree;
begin
Writeln('procedura organizacii dereva');
writeln('dlay vihoda *');
writeln('=========================================');
top:=nil;
while true do
begin
writeln('vvedite Familiu');
readln(z.F);
if z.F='*' then exit;
writeln('imay');
readln(z.I);
writeln('ot4estvo');
readln(z.O);
writeln('vvedite ocenki');
with z.ocenki do
readln(math,history,physyc);
Top:=addTree(top,z);
end;
end;
procedure Dobl;
begin
Writeln('procedura dobavleniay lista');
writeln('dlay vihoda *');
writeln('=========================================');
writeln('vvedite Familiu');
readln(z.F);
if z.F='*' then exit;
writeln('imay');
readln(z.I);
writeln('ot4estvo');
readln(z.O);
writeln('vvedite ocenki');
with z.ocenki do
readln(math,history,physyc);
top:=addTree(top,z);
end;
procedure prosmotr(top:treeprt);
begin
if Top<>nil then
begin
prosmotr(top^.left);
write(tab,top^.inf);
with Top^.inf do
writeln ('³', F:10,' ³', I:10,' ³ ', O:10,' ³ ',ocenki.math:4,' ³ ',ocenki.history:4,' ³ ',ocenki.physyc:4,' ³');
prosmotr(top^.right);
end;
end;
procedure Otobr (top:treeprt; Otstup:integer);
begin
if top<> nil then
begin
otstup:=otstup+3;
otobr(top^.right, otstup);
writeln( ' ':otstup, top^.inf.ocenki.math);
otobr(top^.left, otstup);
end;
end;
procedure obhod (top:treePrt);
begin
reset(tab);
if Top<>nil then
begin
obhod (Top^.Left);
read(tab, top^.inf);
obhod (Top^.Right)
end
end;
procedure nodeCount (top:treeprt;level:integer; var n:integer);
begin
if (level>=1) and (top<> nil) then
begin
if Level=1 then n:=n+1;
nodeCount(top^.left, level-1, n);
nodeCount(top^.right, level-1, n);
end;
end;
begin
assign(tab,'D:\spisok.txt');{$I-}
reset(tab);{$I+}
if IOresult <> 0 then
rewrite(tab);
readln;
repeat
ClrScr;
writeln('1 - cozdanie dereva');
writeln('2 - dobavlenie lista');
writeln('3 - pods4et koli4estva vepshin');
writeln('4 - prosmotr dereva');
writeln('5 - sohranenie ,net');
writeln('6 - pe4at,net');
writeln('7 - vihod');
writeln('______________________');
writeln( 'vvedite punkt menu');
readln(key);
case key of
1:orgtree;
2:dobl;
3:begin
writeln('vvedite # urovnay');
read(level);
N:=0;
nodeCount(top,level,n);
writeln;
writeln('na urovne ', level,' ','nahoditsay ',n,' vershin');
writeln('najmite enter');
readln;
end;
4:begin
writeln ('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿');
writeln ('³last_name ', '³ ', 'first_name ','³ ', 'ot4estvo ³ ', 'math ³ ','history³', 'physyc ³');
writeln ('ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
prosmotr(top);
writeln('======================================================');
writeln;
otobr(top,1);
writeln('najmite enter');
readln;
end;
5:;
6:obhod(top);
end
until key=7;
end.
Полная версия: Бинарное дерево
Помогите пожалуйста. Все процедуры для огранизации дерева работают. Единственное никак не получается сохранить записи в файл и при повторном запуске их прочитать.
Если заполнение дерева и его просмотр действительно работают правильно, то добавь вот это:
procedure savetree(fn: string; top: treeprt);
var
f: file of data;
procedure print(t: treeprt);
begin
if t<>nil then begin
print(t^.left);
write(f, t^.inf);
print(t^.right);
end;
end;
begin
assign(f, fn);
rewrite(f);
print(top);
close(f);
end;
procedure loadtree(fn: string; var top: treeprt);
var
f: file of data;
R: data;
begin
assign(f, fn);
reset(f);
top := nil;
while not eof(f) do begin
read(f, R);
top := addtree(top, R);
end;
close(f);
end;
, и вызывай там, где надо сохранить дерево в файл savetree(имя_файла, корень_дерева), а там, где надо восстановить - loadtree(имя_файла, будущий_корень_дерева)...
Исправила, как подсказали, но все равно не работает
program lab10;
uses CRt;
type
data =record
nomer:integer;
F,I,O:string[15];
Ocenki:record
math,history,physyc:integer
end;end;
Treeprt=^tree;
tree=record
inf:data;
left,right:treeprt
end;
derevo = file of data;
var
top: treeprt;
z:data;
Level,key, n: integer;
i, number: integer;
tab: derevo;
function AddTree (top:treeprt; newnode:data):treeprt;
begin
if top=nil then
begin
new(top);
top^.inf:=newnode;
top^.left:=nil;
top^.right:=nil;
end
else
if top^.inf.ocenki.math>newnode.ocenki.math then
top^.left:=addTree(top^.left,newnode)
else
Top^.right:=addTree(top^.right,newnode);
addTree:= top;
end;
procedure savetree(top:treeprt; var tab: derevo);
var
f: derevo;
procedure print(top: treeprt);
begin
if top<>nil then begin
print(top^.left);
write(f, top^.inf);
print(top^.right);
end;
end;
begin
assign(tab, 'D:\spisok.txt' );
assign(f,'D:\Lab10');
rewrite(f);
print(top);
close(f);
end;
procedure loadtree(var tab: derevo; top: treeprt);
var
f: derevo;
R: data;
begin
assign(tab, 'D:\spisok.txt' );
assign(f,'D:\Lab10');
reset(f);
top := nil;
while not eof(f) do begin
read(f, R);
top := addtree(top, R);
end;
close(f);
end;
procedure OrgTree;
begin
Writeln('procedura organizacii dereva');
writeln('dlay vihoda *');
writeln('=========================================');
top:=nil;
while true do
begin
writeln('vvedite Familiu');
readln(z.F);
if z.F='*' then exit;
writeln('imay');
readln(z.I);
writeln('ot4estvo');
readln(z.O);
writeln('vvedite ocenki');
with z.ocenki do
readln(math,history,physyc);
Top:=addTree(top,z);
end;
end;
procedure Dobl;
begin
Writeln('procedura dobavleniay lista');
writeln('dlay vihoda *');
writeln('=========================================');
writeln('vvedite Familiu');
readln(z.F);
if z.F='*' then exit;
writeln('imay');
readln(z.I);
writeln('ot4estvo');
readln(z.O);
writeln('vvedite ocenki');
with z.ocenki do
readln(math,history,physyc);
top:=addTree(top,z);
end;
procedure prosmotr(top:treeprt);
begin
if Top<>nil then
begin
prosmotr(top^.left);
with Top^.inf do
writeln ('³', F:10,' ³', I:10,' ³ ', O:10,' ³ ',ocenki.math:4,' ³ ',ocenki.history:4,' ³ ',ocenki.physyc:4,' ³');
prosmotr(top^.right);
end;
end;
procedure Otobr (top:treeprt; Otstup:integer);
begin
if top<> nil then
begin
otstup:=otstup+3;
otobr(top^.right, otstup);
writeln( ' ':otstup, top^.inf.ocenki.math);
otobr(top^.left, otstup);
end;
end;
procedure nodeCount (top:treeprt;level:integer; var n:integer);
begin
if (level>=1) and (top<> nil) then
begin
if Level=1 then n:=n+1;
nodeCount(top^.left, level-1, n);
nodeCount(top^.right, level-1, n);
end;
end;
begin
repeat
ClrScr;
writeln('1 - cozdanie dereva');
writeln('2 - dobavlenie lista');
writeln('3 - pods4et koli4estva vepshin');
writeln('4 - prosmotr dereva');
writeln('5 - sohranenie ,net');
writeln('6 - pe4at,net');
writeln('7 - vihod');
writeln('______________________');
writeln( 'vvedite punkt menu');
readln(key);
case key of
1:orgtree;
2:dobl;
3:begin
writeln('vvedite # urovnay');
read(level);
N:=0;
nodeCount(top,level,n);
writeln;
writeln('na urovne ', level,' ','nahoditsay ',n,' vershin');
writeln('najmite enter');
readln;
end;
4:begin
writeln ('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿');
writeln ('³last_name ', '³ ', 'first_name ','³ ', 'ot4estvo ³ ', 'math ³ ','history³', 'physyc ³');
writeln ('ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
prosmotr(top);
writeln('======================================================');
writeln;
otobr(top,1);
writeln('najmite enter');
readln;
end;
5:savetree(top,tab);
6:loadtree(tab,top);
end
until key=7;
end.
"Не работает" - это не ошибка... Я не знаю, работало ли все правильно ДО того, как внесены исправления. Какие данные вводились?
И потом, я не предлагал ТАК... Я предлагал передавать имя файла, а не саму файловую переменную описывать глобально и тягать ее туда-сюда... Не надо ПЕРЕДЕЛЫВАТЬ, а потом предъявлять претензии...
И потом, я не предлагал ТАК... Я предлагал передавать имя файла, а не саму файловую переменную описывать глобально и тягать ее туда-сюда... Не надо ПЕРЕДЕЛЫВАТЬ, а потом предъявлять претензии...
Претензий на самом деле нет никаких. Если я неправильно поняла, это только моя ошибка. Но дело не в этом.
Задание такое, программа должна создавать дерево в файле и создавать его заново при повторном запуске. Только в этом вопрос.
Я допускаю, что в моем варианте проги данные сохраняются в файле, но вот считать их оттуда не получается
Задание такое, программа должна создавать дерево в файле и создавать его заново при повторном запуске. Только в этом вопрос.
Я допускаю, что в моем варианте проги данные сохраняются в файле, но вот считать их оттуда не получается
Ну, смотри: сами процедуры я написал выше... Без изменений добавь их в свою программу. А вызывать - так:
begin
repeat
ClrScr;
writeln('1 - cozdanie dereva');
writeln('2 - dobavlenie lista');
writeln('3 - pods4et koli4estva vepshin');
writeln('4 - prosmotr dereva');
writeln('5 - save_tree');
writeln('6 - load_tree');
writeln('7 - vihod');
writeln('______________________');
writeln( 'vvedite punkt menu');
readln(key);
case key of
{ Тут все пункты, от 1-го до 4-го }
5: savetree('tree.dat', top); { <--- Можешь поменять путь к файлу }
6: begin
top := nil;
loadtree('tree.dat', top); { <--- Здесь - тот же путь, что и выше... Я бы оформил его константой }
end;
end { case }
until key = 7;
end.
Только что проверил... После сохранения дерева в файл и перезапуска программы дерево успешно считывается...
Да, работает, спасибо огромное. 
У меня вот затесался вопросик. Учитывая, что в данном случае мы сохраняем бинарное дерево слева направо, то оно при данном считывания вырождается в линейный список. Следовательно, как я понял, чтоб структура сохранялась процедура сохранения должна выглядеть, как идущая сверху вниз.
Очень интересно узнать, а можно ли после записи слева направо восстановить структуру дерева?
procedure savetree(top:treeprt; var tab: derevo);
var
f: derevo;
procedure print(top: treeprt);
begin
write(f, t^.data);
if t^.left<>nil then print(t^.left);
if t^.right<>nil then print(t^.right);
end;
begin
assign(tab, 'D:\spisok.txt' );
assign(f,'D:\Lab10');
rewrite(f);
print(top);
close(f);
end;
procedure loadtree(var tab: derevo; top: treeprt);
var
f: derevo;
R: data;
begin
assign(tab, 'D:\spisok.txt' );
assign(f,'D:\Lab10');
reset(f);
top := nil;
while not eof(f) do begin
read(f, R);
top := addtree(top, R);
end;
close(f);
end;
Очень интересно узнать, а можно ли после записи слева направо восстановить структуру дерева?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.