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

[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.

[ALma]

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

Сообщение отредактировано: ALma - 16.02.2009 2: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;

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