Отсортировать данные в файле - Pascal ABC

Формулировка задачи:

В файле data.txt записаны числа, сколько их – неизвестно. Создать из него файл четных чисел и отсортировать их на диске.


textual

Код к задаче: «Отсортировать данные в файле - Pascal ABC»

const CR: char = #13;
      LF: char = #10;
 
var F: file of char;
    Pos1, Pos2: longword;
    String1, String2: string;
    N1, N2: longint;
    Symbol: char;
    NoSwap: boolean;
    Error, StringCount, i: integer;
 
//процедура чтения строки из файла с текущей позиции файла
procedure ReadString(var s: string; var n: integer);
var c: char;
begin
  s := '';
  repeat
    read(F, c); //читаем символ из файла
    if not (c in [LF, CR]) then s := s + c //пишем в строку, если символ не LF или CR
  until c = LF; //читаем из файла до LF
  if not (s[1] in ['0'..'9', '-', '+']) then Error := 1;
  //эта проверка для совместимости с диалектами паскаля, в которых процедура val
  //игнорирует (пропускает) неправильное начало строки
  if Error = 0 then val(s, n, Error) //если начало строки верное, пытаемся строку преобразовать в число
end;
 
//процедура печати строки в файл с текущей позиции файла
procedure WriteString(s: string);
var i: integer;
begin
  for i := 1 to length(s) do write(F, s[i]);
  write(F, CR, LF)
end;
 
begin
  assign(F, 'file.txt');
  reset(f);
  //правим невидимое и неверное в конце файла и тестируем на нулевую длину
  while (FileSize(F) > 0) do
    begin
      Pos1 := FileSize(F) - 1; //переходим в конец файла
      seek(F, Pos1);
      read(F, Symbol); //читаем символ
      if not (Symbol in ['0'..'9']) //если последний символ не цифровой, усекаем файл
        then begin
          seek(F, Pos1);
          truncate(F);
        end
        else break
    end;
  write(F, CR, LF); //добавляем разделитель строк в конец файла
  if FileSize(F) = 2 //если файл пустой,
    then writeln('Файл не содержит чисел.') //то печатаем сообщение и сортировку не выполняем
    else begin //иначе сортируем файл
      //Пузырьковая сортировка
      Error := 0; //пока считаем, что ошибок нет
      repeat
        reset(F); //начало очередного прохода: позиция в файле = 0
        Pos1 := 0; //очередная позиция первого числа
        StringCount := 1; //счётчик строк = 1
        NoSwap := TRUE; //перестановок ещё не было
        ReadString(String2, N2); //читаем первую строку во второе число
        while (Error = 0) and not EOF(F) do //цикл очередного прохода сортировки
          begin
            N1 := N2; //переносим второе число в первое
            String1 := String2;
            Pos2 := FilePos(F); //запоминаем позицию второго числа
            inc(StringCount); //счётчик строок + 1
            ReadString(String2, N2); //читаем второе число
            if (Error = 0) and (N1 > N2) //если нет ошибок и первое число больше
              then begin //то меняем числа местами
                NoSwap := false; //был обмен
                seek(f, Pos1); //переходим на позицию первого числа
                WriteString(String2); //выводим в файл сначала второе число
                Pos1 := FilePos(F); //позиция очередного первого числа
                WriteString(String1); //затем выводим в файл первое число
                N2 := N1; //присваиваем второму числу первое
                string2 := String1
              end
              else Pos1 := Pos2 //иначе второе число становится очередным первым
          end;
      until (Error > 0) or NoSwap; //сортировать до тех пор, пока есть обмен
      {Если в файле есть ошибочные строки, печатаем сообщение}
      if Error = 0
        then writeln('Сортировка завершена.')
        else begin
          writeln('Сортировка не завершена, ошибка в строке ', StringCount, ':');
          writeln('"', string2, '"');
          for i := 1 to Error do write(' ');
          writeln('^')
        end
    end;
  close(F);
  write('Нажмите <Enter> для выхода из программы.');
  readln
end.
Эта работа вам не подошла?

Вы всегда можете заказать любую учебную работу у наших авторов от 20 руб.


СДЕЛАЙТЕ РЕПОСТ

10   голосов, оценка 4.500 из 5

Источник