IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Бинарное дерево, не получается сохранить и прочитать из файла
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Женский

Репутация: -  0  +


Помогите пожалуйста. Все процедуры для огранизации дерева работают. Единственное никак не получается сохранить записи в файл и при повторном запуске их прочитать.


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.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 12.05.2024 13:01
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name