Помощь - Поиск - Пользователи - Календарь
Полная версия: Сортировка последовательных файлов слиянием
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Ирина
Здравствуйте все!!!
Пожалуйста посмотрите и подскажите в чём дело, не работает программа. Нужно использовать сортировку последовательных файлов слиянием. Процедуры вроде бы верны - смотрела по учебному пособию. Но что-то не так, не могу понять, толкусь на одном месте.

Код
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.
volvo
Ирина,
а зачем тебе понадобилось вносить данные в текстовый файл, а потом его же открывать как типизированный? Это, извини, не значит, что ты конвертировала данные в нужный формат... Пиши сразу в процедуре 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.
Ирина
Спасибо, Volvo! Огромное спасибо!!!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.