Здравствуйте! Помогите, если можете, решить простую (IMHO) задачку на работу с файлом.
Вот условие.
_Ввести с клавиатуры файл действительных чисел.
_Переместить в нём все нули в конец, сохраняя порядок следования остальных компонент.
_ДОПОЛНИТЕЛЬНЫЙ ФАЙЛ ИЛИ МАССИВ НЕ СОЗДАВАТЬ!
_Выдать результирующий файл или сообщение, что это невозможно...
Заранее премного благодарен.
Полная версия: Задача на работу с файлами.
Цитата(1nSAnder @ 3.03.05 17:32)
Помогите, если можете, решить простую (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.
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.
Спасибо. Нет, дело не в том, что я из лени, что ли, не хочу решать, а в том ч, что задачи-то можно решить разными способами...
Я, например, решал (вернее, пробовал) её много др. способом.
Я, например, решал (вернее, пробовал) её много др. способом.
Ну-ка подробнее.... расскажите как вы ее пробовали решать, мне интересно...
Вот...
Это всё, что я нарешал...
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: Диск рид еррор!!!
Найдите, пож-та, если не трудно.
З.Ы. Прогу проверял мой препод по информатике. На первый взгляд ничего не сказал. И на второй тоже. Сказал просто: "Сам думай!" (А ведь прав!!!)
Это всё, что я нарешал...
Код
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: Диск рид еррор!!!
Найдите, пож-та, если не трудно.
З.Ы. Прогу проверял мой препод по информатике. На первый взгляд ничего не сказал. И на второй тоже. Сказал просто: "Сам думай!" (А ведь прав!!!)
Цитата(1nSAnder @ 18.03.05 17:23)
Тут где-то ошибка намбер 100: Диск рид еррор!!!
Найдите, пож-та, если не трудно.
Найдите, пож-та, если не трудно.
А самому найти? Как мы ее искать будем? Точно так же и попробуйте: F7 - пошаговый прогон. Даст Вам точное местоположение ошибки... Преподаватель информатики совершенно прав: "Сам думай!"
Ну, узазал мне 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;
А в чём загвоздка-то? Вроде всё правильно!
Код
{Удаление нулей=============================================}
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;
А в чём загвоздка-то? Вроде всё правильно!
Цитата(Guest @ 18.03.05 18:00)
А в чём загвоздка-то? Вроде всё правильно!
Да нет, не все правильно... Тут происходит чтение за концом файла ... А это - ошибка №100... Исправляйте...
Про чтение понял, а что исправить - недопетрил...
Может намёк потолще мне поможет?
Может намёк потолще мне поможет?
Код
for i:=n to fs - 1 do
Что-то типа этого ...
Цитата(volvo @ 18.03.05 23:02)
Код
for i:=n to fs - 1 do
Что-то типа этого ...
volvo, мне показалось или у него переменная i нигде не описана?
Вот всё, что я надумал и исправил!!!
А прога всё равно не пахает!!!
А прога всё равно не пахает!!!
Исходный код
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.
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.
Ну и кто из нас учится? Я?
Держи (только прежде чем сказать, что и это НЕ работает, учти, что прога прошла около 200 тестов...)
Держи (только прежде чем сказать, что и это НЕ работает, учти, что прога прошла около 200 тестов...)
Это , конечно, хорошо, но мне бы хотелось разобраться со своей задачей, т.к. она решена ч-з процедуры, как требует мой преподаватель...
З.Ы. Да, наверное, будете смеяться, но прога всё равно не пахает... Чё за ошибка 116. Может я че недопетрил?
З.Ы. Да, наверное, будете смеяться, но прога всё равно не пахает... Чё за ошибка 116. Может я че недопетрил?
Вот это извините... Я в ЭТО не верю...
А ошибка 116 - это у Вас среда неправильно настроена...
1-ой строкой в программу добавьте {$N+}
А ошибка 116 - это у Вас среда неправильно настроена...
1-ой строкой в программу добавьте {$N+}
А не, всё правильно... Вернее почти всё: потребовалось (после рытья в учебнике) заменить все даблы на интежеры. Прога пашет!!! Спасибо!
Но... давайте всё же попробуем разобраться с моей программой...
Но... давайте всё же попробуем разобраться с моей программой...
Нет... С вашей программой (с такими знаниями - "заменить 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.
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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.