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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


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

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(имя_файла, будущий_корень_дерева)...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 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 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


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

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





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

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

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


Гость
Ну, смотри: сами процедуры я написал выше... Без изменений добавь их в свою программу. А вызывать - так:
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.
Только что проверил... После сохранения дерева в файл и перезапуска программы дерево успешно считывается...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





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

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

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

Сообщение отредактировано: ALma -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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

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

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;



Очень интересно узнать, а можно ли после записи слева направо восстановить структуру дерева?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
« Предыдущая тема · Задачи · Следующая тема »
 

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

 

Режим отображения: Стандартный · Переключить на: Линейный · Переключить на: Древовидный

Подписка на тему · Сообщить другу · Версия для печати · Подписка на этот форум



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