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

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

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

 
 Ответить  Открыть новую тему 
> Сортировка последовательных файлов слиянием
сообщение
Сообщение #1





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

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


Здравствуйте все!!!
Пожалуйста посмотрите и подскажите в чём дело, не работает программа. Нужно использовать сортировку последовательных файлов слиянием. Процедуры вроде бы верны - смотрела по учебному пособию. Но что-то не так, не могу понять, толкусь на одном месте.

Код
program Lab3;
uses CRT;
type
    date=Record
        den:1..31;
        mes:1..12;
        god:00..99
    end;
    filetype=file of date;        {файловый тип, который работает с данными типа date}
    var
   F, F1, F2: text;
   a, b, c, d: filetype;
   s, d1, d2: char;
   n, k, l: integer;
   r,buf:date;
   eor:boolean;

{_____________процедура      ___________}
procedure view;
   var buf:date;
    begin
      reset(c);
        repeat
            read(c, buf);
            writeln(buf.den,' ',buf.mes,' ',buf.god);
        until eof(c);
   readkey;
         end;
{________________процедура ____________}

procedure copy(var x,y:filetype);
     var buf,buf1:date;
       begin
          read(x,buf);
          write(y,buf);
       if eof(x) then eor:=true
       else begin
          read(x,buf1);
          seek(x,filepos(x)-1);
          eor:=buf1.mes<buf.mes
       end;
     end;
{______процедура переписи одной серии из x в y _______________}
   procedure copyrun(var x,y: filetype);
     begin
       repeat copy(x,y)
       until eor
     end;
{_________из файла с в файлы а и b _________}
procedure distribute;
  begin
    reset(c);
    rewrite(a);
    rewrite(b);
    rewrite(d);
      repeat
        copyrun(c, a);
          if not eof(c)
        then copyrun(c, b);
      until eof(c);
    close(a);
    close(b);
    close(c);
  end;
{______из файла a и b в файл d______________________}
procedure Mergerun;
     var bufa, bufb: date;
     begin
     repeat
       read(a,bufa); seek(a,filepos(a)-1);
       read(b,bufb); seek(b,filepos(b)-1);
            if bufa.mes<bufb.mes
                then
                  begin copy (a,d);
            if eor
                  then copyrun(b,d);
            end
         else
           begin copy(b,d);
             if eor
               then copyrun(a,d);
           end;
     until eor
   end;
{___________запись из файлов a и b в файл d  _____________}
procedure merge;
    begin
      reset(a);
      reset(b);
      rewrite(d);
      while (not eof(a)) and (not eof(b)) do
         begin
           mergerun; l:=l+1;
         end;
      while not eof(a) do
         begin
           copyrun(a,d); l:=l+1;
         end;
      while not eof(b) do
         begin
           copyrun(b,d); l:=l+1;
         end;
      close(a);
      close(b);
      close(d);
    end;

{______________процедура вода последовательности_________________}
  procedure Vvod;
  var
     r:date;
  begin
  assign(F,'c:\f.txt');
  rewrite(F);
                                 {откроем файл для записи}
  writeln('Введите дату рождения в формате дд мм гг.');
  repeat
     readln(r.den,r.mes,r.god);n:=n+1;                  {введём с клавиатуры в оперативную память данные}
     writeln(F,r.den,' ',r.mes,' ',r.god);       {записываем данные в файл F}
     writeln('Вы закончили ввод данных? y/n');
     readln(s);
    until s='y';
     writeln('Вы сделали ',n, 'запись');
     readln;
     close(F);
   end;

{_______основная программа______________________________}
   begin
  ClrScr;
  n:=0;
        Vvod;
    assign(C,'c:\f.txt');
    assign(a,'c:\a.txt');
    assign(b,'c:\b.txt');
    assign(d,'c:\d.txt');
       repeat
          distribute; l:=0;
          merge;
       until l=1;
        writeln;
        view;
      end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Ирина,
а зачем тебе понадобилось вносить данные в текстовый файл, а потом его же открывать как типизированный? Это, извини, не значит, что ты конвертировала данные в нужный формат... Пиши сразу в процедуре Vvod в типизированный... Вот так я когда-то делал (copyrun сделал функцией, чтобы с ней было удобнее работать):
program naturalmerge;
uses CRT;

type
item =Record
den:1..31;
mes:1..12;
god:0..99;
end;

filetype = file of item;

var
a, b, c: filetype;
z: integer;
eor: boolean;

procedure view;
var buf:item;
begin
reset( c );
repeat
read(c, buf);
writeln(buf.den,' ',buf.mes,' ',buf.god);
until eof( c );
readkey;
end;

procedure copy(var x, y:filetype);
var buf, buf1: item;
begin
read(x, buf); write(y, buf);
if eof(x) then eor := true
else begin
read(x,buf1);
seek(x,filepos(x)-1);
eor:=buf1.mes < buf.mes
end;
end;

function copyrun(var x, y: filetype): byte;
begin
repeat
copy(x, y);
until eor;
copyrun := 1;
end;

procedure distribute;
begin
reset( c );rewrite(a);rewrite(b);
repeat
copyrun(c,a);
if not eof( c ) then copyrun(c,b);
until eof( c );
close(a);close(b);close( c );
end;


procedure merge;

procedure make(var x, y: filetype);
begin
copy(x, c);
if eor then copyrun(y, c);
end;

var bufa,bufb:item;
begin
reset(a); reset(b); rewrite( c );
while (not eof(a)) and (not eof(b)) do begin

repeat
read(a, bufa);seek(a, filepos(a)-1);
read(b, bufb);seek(b, filepos(b)-1);

if bufa.mes < bufb.mes then make(a, b)
else make(b, a);
until eor;
inc(z);

end;

while not eof(a) do
inc(z, copyrun(a, c));
while not eof(b) do
inc(z, copyrun(b, c));
close(a);close(b);close( c );
end;

procedure Vvod;
var
r:item;
n: integer;
s: string;
begin
rewrite( c );
writeln('enter: dd mm yy');
n := 0;
repeat
readln(r.den, r.mes, r.god); n:=n+1;
write(c, r);
writeln('finished [y/n] ?');
readln(s);
until s='y';
writeln('you entered ', n, ' records');
readln;
close( c );
end;


begin {main}
assign(a,'a.txt');
assign(b,'b.txt');
assign(c,'c.txt');
vvod;
repeat
distribute;
z:=0;
merge;
until z=1;
writeln;
view;
end.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


Спасибо, Volvo! Огромное спасибо!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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