Задача на работу с файлами., Сортировка файла. Опции

[1nSAnder]

Здравствуйте! Помогите, если можете, решить простую (IMHO) задачку на работу с файлом.
Вот условие.
_Ввести с клавиатуры файл действительных чисел.
_Переместить в нём все нули в конец, сохраняя порядок следования остальных компонент.
_ДОПОЛНИТЕЛЬНЫЙ ФАЙЛ ИЛИ МАССИВ НЕ СОЗДАВАТЬ!
_Выдать результирующий файл или сообщение, что это невозможно...
Заранее премного благодарен.

[volvo]

Помогите, если можете, решить простую (IMHO) задачку на работу с файлом.

Ну если она простая, чего же сами не решаете?

В принципе, ничего сложного. Просто читаем данные из файла последовательно, и храним индексы для чтения следующего элемента и для записи следующего элемента... Перезаписываем, естественно, только ненулевые элементы. Остаток файла забиваем нулями. Примерно вот так:

Код

const
 n = 10;
var
 f: file of double;

var
 i: integer;
 x: double;
 f_read, f_write: longint;

begin
 assign(f, 'test.ttt');
 rewrite(f);

 for i := 1 to n do
   begin
     write('x(', i, ') = ');
     readln(x); write(f, x)
   end;

 reset(f);

 { устанавливаем начальные значения указателей }
 while { есть что читать } do
   begin
     { прочитать следующий элемент в X и передвинуть указатель для чтения }

     if x <> 0 then { записать X в файл и передвинуть указатель для записи }
   end;

 { до конца файла перезаписать компоненты нулями }

 WriteLn('Проверка:');
 reset(f);
 while not eof(f) do
   begin
     read(f, x);
     writeln(x:8:4)
   end;

 close(f)
end.

[1nSAnder]

Спасибо. Нет, дело не в том, что я из лени, что ли, не хочу решать, а в том ч, что задачи-то можно решить разными способами...
Я, например, решал (вернее, пробовал) её много др. способом.

[Altair]

Ну-ка подробнее.... расскажите как вы ее пробовали решать, мне интересно...

[1nSAnder]

Вот...
Это всё, что я нарешал...

Код

Program P2_3_FILE;
 Type
   tf= file of integer;
 Var
   f: tf;
   siz:longint;
{Ввод файла=================================================}
 Procedure InputF (var ff:tf);
   Var
     x:integer;
   Begin
     writeln ('Создание файла. Конец файла = 777');
     rewrite (ff);
     write ('Ввод компоненты ');
     readln (x);
     while x<>777 do
       begin
         write (ff,x);
         write ('Ввод компоненты ');
         readln (x)
       end;
     close (ff);
   End;
{Вывод файла================================================}
 Procedure OutputF (var ff:tf);
   Var
     x: integer;
   Begin
     writeln ('Вывод файла ');
     reset (ff);
     while not eof (ff) do
       begin
         read (ff,x);
         write (x, ' ')
       end;
     writeln;
     close (ff);
     writeln ('Вывод закончен');
   End;
{Удаление нулей=============================================}
Procedure DelOf0 (var ff:tf);
 Var
   x,y: integer;
   n: byte;
   fs: longint;
 Begin
   reset (ff);
   fs:= filesize (ff);
   while not eof (ff) do
     begin
       read (ff,x);
       if x=0
         then
           begin
             n:= filepos (ff)-1;
             for i:=n to fs do
               begin
                 seek (ff,i);
                 read (ff,x);
                 seek (ff, i-1);
                 write (ff,x)
               end
           end
     end;
   close (ff)
 End;
{Добавление нулей===========================================}
Procedure Add0 (var ff:tf; var fs:longint; q: integer);
 Begin
   reset (ff);
   seek (ff, filesize (ff));
   while filesize (ff)<=fs do
     begin
      write (ff,q)
     end;
   close (ff)
 End;
{Основная программа=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
BEGIN
 Assign (f, 'fx.d');
 InputF (f);
 OutputF (f);
 DelOf0 (f);
 Add0 (f,siz,0);
 OutputF (f)
END.

Тут где-то ошибка намбер 100: Диск рид еррор!!!
Найдите, пож-та, если не трудно.
З.Ы. Прогу проверял мой препод по информатике. На первый взгляд ничего не сказал. И на второй тоже. Сказал просто: "Сам думай!" (А ведь прав!!!)

[volvo]

Тут где-то ошибка намбер 100: Диск рид еррор!!!
Найдите, пож-та, если не трудно.

А самому найти? Как мы ее искать будем? Точно так же и попробуйте: F7 - пошаговый прогон. Даст Вам точное местоположение ошибки... Преподаватель информатики совершенно прав: "Сам думай!"

[Guest]

Ну, узазал мне TP на строчку:

Код

{Удаление нулей=============================================}
Procedure DelOf0 (var ff:tf);
Var
  x,y: integer;
  n: byte;
  fs: longint;
Begin
  reset (ff);
  fs:= filesize (ff);
  while not eof (ff) do
    begin
      read (ff,x);
      if x=0
        then
          begin
            n:= filepos (ff)-1;
            for i:=n to fs do
              begin
                seek (ff,i);
                read (ff,x); { *** Здесь *** }
                seek (ff, i-1);
                write (ff,x)
              end
          end
    end;
  close (ff)
End;

А в чём загвоздка-то? Вроде всё правильно!

[volvo]

А в чём загвоздка-то? Вроде всё правильно!

Да нет, не все правильно... Тут происходит чтение за концом файла ... А это - ошибка №100... Исправляйте...

[Guest]

Про чтение понял, а что исправить - недопетрил...
Может намёк потолще мне поможет?

[volvo]

Код

            for i:=n to fs - 1 do

Что-то типа этого ...

[Людмила]

Код

            for i:=n to fs - 1 do

Что-то типа этого ...

volvo, мне показалось или у него переменная i нигде не описана?

[1nSAnder]

Вот всё, что я надумал и исправил!!!
А прога всё равно не пахает!!!

Исходный код

Program P2_3_FILE;
Type
tf= file of integer;
Var
f: tf;
siz:longint;
{Ввод файла=================================================}
Procedure InputF (var ff:tf);
Var
x:integer;
Begin
writeln ('Создание файла. Конец файла = 777');
rewrite (ff);
write ('Ввод компоненты ');
readln (x);
while x<>777 do
begin
write (ff,x);
write ('Ввод компоненты ');
readln (x)
end;
close (ff);
End;
{Вывод файла================================================}
Procedure OutputF (var ff:tf);
Var
x: integer;
Begin
writeln ('Вывод файла ');
reset (ff);
while not eof (ff) do
begin
read (ff,x);
write (x, ' ')
end;
writeln;
close (ff);
writeln ('Вывод закончен');
End;
{Удаление нулей=============================================}
Procedure DelOf0 (var ff:tf);
Var
x,y: integer;
n,i: byte;
fs: longint;
Begin
reset (ff);
fs:= filesize (ff);
while not eof (ff) do
begin
read (ff,x);
if x=0
then
begin
n:= filepos (ff)-1;
for i:=n to fs-1 do
begin
seek (ff,i);
read (ff,x);
seek (ff,i-1);
write (ff,x)
end
end;
seek (ff,fs-1);
truncate (ff)
end;
close (ff)
End;
{Добавление нулей===========================================}
Procedure Add0 (var ff:tf; var fs:longint; q: integer);
Begin
reset (ff);
seek (ff, filesize (ff));
while filesize (ff)<=fs do
begin
write (ff,q)
end;
close (ff)
End;
{Основная программа=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
BEGIN
Assign (f, 'fx.d');
InputF (f);
OutputF (f);
DelOf0 (f);
Add0 (f,siz,0);
OutputF (f)
END.

[volvo]

Ну и кто из нас учится? Я?
Держи (только прежде чем сказать, что и это НЕ работает, учти, что прога прошла около 200 тестов...)

[1nSAnder]

Это , конечно, хорошо, но мне бы хотелось разобраться со своей задачей, т.к. она решена ч-з процедуры, как требует мой преподаватель...
З.Ы. Да, наверное, будете смеяться, но прога всё равно не пахает... Чё за ошибка 116. Может я че недопетрил?

[volvo]

Вот это извините... Я в ЭТО не верю...
А ошибка 116 - это у Вас среда неправильно настроена...

1-ой строкой в программу добавьте {$N+}

[1nSAnder]

А не, всё правильно... Вернее почти всё: потребовалось (после рытья в учебнике) заменить все даблы на интежеры. Прога пашет!!! Спасибо!
Но... давайте всё же попробуем разобраться с моей программой...

[volvo]

Нет... С вашей программой (с такими знаниями - "заменить Double на Integer", Вы условие-то свое сами читали???) Вы будете разбираться сами...

Это все, что я могу предложить (она тоже работает с процедурами):

Исходный код

const
n = 10;

type
freal = file of real;
var
f: freal;

var
i: integer;
x: real;
f_read, f_write: longint;

procedure read_file(var f: freal);
begin
rewrite(f);

for i := 1 to n do
begin
write('x(', i, ') = ');
readln(x); write(f, x)
end;
close(f)
end;

procedure move_zeroes(var f: freal);
begin
reset(f);

f_write := 0; f_read := 0;
while f_read <> filesize(f) do
begin
seek(f, f_read);
read(f, x);
f_read := filepos(f);

if x <> 0 then
begin
seek(f, f_write);
write(f, x);
f_write := filepos(f);
end;
end;

seek(f, f_write); x := 0;
for i := 1 to filesize(f) - f_write do
write(f, x);
close(f)
end;

procedure out_f(var f: freal);
begin
reset(f);
while not eof(f) do
begin
read(f, x);
writeln(x:8:4)
end;
close(f)
end;

begin
assign(f, 'test.ttt');
read_file(f);
writeln('before:');
out_f(f);
move_zeroes(f);
writeln('after:');
out_f(f)
end.