Бинарное дерево, не получается сохранить и прочитать из файла Опции

[ALma]

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

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.

[volvo]

Если заполнение дерева и его просмотр действительно работают правильно, то добавь вот это:

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(имя_файла, будущий_корень_дерева)...

[ALma]

Исправила, как подсказали, но все равно не работает

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.

[volvo]

"Не работает" - это не ошибка... Я не знаю, работало ли все правильно ДО того, как внесены исправления. Какие данные вводились?

И потом, я не предлагал ТАК... Я предлагал передавать имя файла, а не саму файловую переменную описывать глобально и тягать ее туда-сюда... Не надо ПЕРЕДЕЛЫВАТЬ, а потом предъявлять претензии...

[ALma]

Претензий на самом деле нет никаких. Если я неправильно поняла, это только моя ошибка. Но дело не в этом.
Задание такое, программа должна создавать дерево в файле и создавать его заново при повторном запуске. Только в этом вопрос.
Я допускаю, что в моем варианте проги данные сохраняются в файле, но вот считать их оттуда не получается

[volvo]

Ну, смотри: сами процедуры я написал выше... Без изменений добавь их в свою программу. А вызывать - так:

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.

Только что проверил... После сохранения дерева в файл и перезапуска программы дерево успешно считывается...

[ALma]

Да, работает, спасибо огромное.

Сообщение отредактировано: ALma - 15.02.2009 22:16

[TheKnyazz]

У меня вот затесался вопросик. Учитывая, что в данном случае мы сохраняем бинарное дерево слева направо, то оно при данном считывания вырождается в линейный список. Следовательно, как я понял, чтоб структура сохранялась процедура сохранения должна выглядеть, как идущая сверху вниз.

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;

Очень интересно узнать, а можно ли после записи слева направо восстановить структуру дерева?