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


program Lab3;
uses crt;
var f, g: text;
y, x :string; i:integer;

begin
clrscr;
assign(f,'C:\bp\bin\t.txt');
reset(f);
writeln('Содержание файла <f>');
repeat
readln(f, y);
writeln(' ', y);
until (eof(f));
close(f);
end.

bura
Тебе надо найти последнее слово. Потом снова надо будет считывать строки из первого файла. А далее можно будет делать двумя способами.
1-й способ. Из считанной из первого файла строки выделяешь слова и сравниваешь их с последним словом. Если слово не равно последнему слову, то записываешь его во второй файл. Если равно последнему слову, то не записываешь во второй файл. И так до конца первого файла.
2-й способ. Ищешь в считанной из первого файла строке вхождение последнего слова. Если слово присутствует в строке, то удаляешь его из строки. Проверяешь строку до тех пор, пока все слова, одинаковые с последним, не будут удалены из строки. Потом строку записываешь во второй файл. Так поступаешь со всеми строками первого файла.
Анисия
Делаю цикл обратный,

for i:=length(y) downto 1 do


только не могу придумать как сделать условие чтоб выбиралось слово.
maksimla
может сделай так раз отделены слова пробелом то
 
if y[i]=' ' then
begin
for j:=i to length(y) do
n:=n+y[j];


ну както так я непроверял несмотрел
Unconnected
Цитата
program Lab3;
uses crt;
var f, g: text;
y, x :string; i:integer;

begin
clrscr;
assign(f,'C:\bp\bin\t.txt');
reset(f);
writeln('Содержание файла <f>');
repeat
readln(f, y);
writeln(' ', y);
until (eof(f));
close(f);
end.


Ты читаешь в переменную у и при следующей итерации затираешь предыдущее значение. Т.е. просто выводишь строки на экран, они нигде не сохраняются.
Unconnected
Код
var f:text;
    y,y2,y3,y4:string;
    a:integer;
begin
  assign(f,'input.txt');
  reset(f);
  repeat
    readln(f,y2);
    y:=y+y2+' ';
  until eof(f);
  close(f);
  delete(y,length(y),1);
  for a:=length(y) downto 1 do
    if y[a]=' ' then begin
                       y3:=copy(y,a+1,length(y)-a);
                       break;
                     end;
  assign(f,'output.txt');
  rewrite(f);
  for a:=1 to length(y) do
    if y[a]=' ' then begin
                       y4:=copy(y,1,a-1);
                       if not(y4=y3) then writeln(f,y4);
                       delete(y,1,a);
                     end;
  close(f);
  readln;
end.


Разбиение на слова самое примитивное, не обрабатываются пробелы перед/после дефиса и т.п.
Lapp
Цитата(Unconnected @ 2.03.2009 20:04) *
не обрабатываются пробелы перед/после дефиса
и что за пробелы такие перед/после дефиса?.. blink.gif

Unconnected, а ты вообще проверяешь свои решения?..
Lapp
Вот простенькое решение. Учти, что я интерпретировал твои слова о том, что слова разделены только пробелами буквально (концы строк не разделяют слова). Если не нравится так - можно поговорить о том, как это исправить.
Программа годится для файлов _любой_ длины, но длина одного слова не должна превосходить длины строки (255).

var
f: file of char;
g: text;
s,t: string;
c,d: char;

begin
Assign(f,'in.txt');
ReSet(f);
s:='';
while not EoF(f) do begin
Read(f,c);
if c<>' ' then if d=' ' then s:=c else s:=s+c;
d:=c
end;
ReSet(f);
Assign(g,'out.txt');
ReWrite(g);
t:='';
while not EoF(f) do begin
Read(f,c);
if c=' ' then begin
if t<>s then Write(g,t,' ');
t:=''
end
else t:=t+c
end;
Close(g);
Close(f)
end.
Анисия
Спасибо большое за помощь, вот что у меня получилось.

program Lab3;
uses crt;
const m=[' '];
var f, g: text;
y, x, z:string; i:integer;

begin
clrscr;
assign(f,'C:\bp\bin\t.txt');
reset(f);
assign(g,'C:\bp\bin\g.txt');
rewrite(g);
writeln('Содержание файла <f>');
repeat
readln(f,y);
writeln(' ', y);

for i:=length(y) downto 1 do
if (y[i]=' ') then begin
x:=copy(y, i+1,length(y)-i);
break;
end;
until (eof(f));
writeln(g, x) ;
close(f);
close(g);
readln;
end.



Добавлено через 3 мин.
Lapp спасибо за помощь, но два часа ковыряний сегодня у меня не прошли даром. smile.gif
Lapp
Цитата(Анисия @ 3.03.2009 7:03) *
вот что у меня получилось.
...
два часа ковыряний сегодня у меня не прошли даром.
Это в высшей степени похвально)). Я немного причесал твою прогу (постарайся разобраться с правильным форматированием - это несложно) и написал несколько замечаний.
program Lab3;
uses
crt; {CRT нужна только для ClrScr? Вредная штука эта CRT..}

const
m=[' ']; {а это чудо зачем тебе?? нигде, вроде, не используется..}

var
f, g: text;
y, x, z:string; i:integer; {а z зачеи понадобилось?..}

begin
clrscr; {зачем это? типа чистенько? не надо без нужды стирать и свое, и чужое}
assign(f,'t.txt'); {неужели ты все делаешь в c:\bp\bin?? жуткий бардак, наверное..}
{создавай свою дир для каждой задачи и работайц в ней}
reset(f);
assign(g,'g.txt');
rewrite(g);
writeln('Содержание файла <f>');
repeat
readln(f,y);
writeln(' ', y);
for i:=length(y) downto 1 do if y[i]=' ' then begin
x:=copy(y, i+1,length(y)-i); {это ты находишь последнее слово? почему в каждой строке?}
break; {неудачная конструкция. Используй while - не нужен будет break}
end;
until (eof(f));
writeln(g, x) ; {наконец-то что-то попало и в g smile.gif. Только то ли, что надо?}
close(f);
close(g);
readln;
end.

Но требуемым результатом пока не пахнет)).
По-хорошему, (если уж хочешь наворотов,) нужно сделать что-то типа функции для чтения следующего слова из текста. Тогда вся программа будет состоять из двух проходов: первый раз до последнего слова, а второй с записью в выходной файл нужных слов.

Преимущество моего варианта состоит в минимальности накладываемых ограничений. Вот встретится тебе в файле строка с количеством букв больше 255 - и что делать?

Не обращай внимания на мое брюзжание)), делай как делается. Покажи, что получится еще через два часа.. smile.gif
Анисия
Правильно сказали, я не то совсем нахожу...... спасибо за подсказку smile.gif буду дальше делать.
Unconnected
Цитата
не обрабатываются пробелы перед/после дефиса
и что за пробелы такие перед/после дефиса?..

Unconnected, а ты вообще проверяешь свои решения?..


Насчёт дефиса - это я имел в виду, что если дать программе word - word например, то '-' будет считаться за слово. А решение я проверял. Входной файл:

Цитата
abc defg hig klm nopqr


Выходной файл:

Цитата
abc
defg
hig klm


Вот что не в строку пишет это да.
Lapp
Цитата(Unconnected @ 3.03.2009 13:44) *
Насчёт дефиса - это я имел в виду, что если дать программе word - word например, то '-' будет считаться за слово.
Я извиняюсь за излишние придирки, я хотел сказать, что то, что ты имеешь в виду называется в русском языке "тире" (хлеб - всему голова), а дефис соединяет два слова (как-то, сильно-пресильно) и никаких пробелов при нем в принципе быть не может. Правда, в обычном компьютерном тексте (txt) оба они как правило представлены одним символом (минусом), так что различимы только по контексту. Еще раз извиняюсь, я понимаю, что это форум не филологов..

Думаю, то, что тире считается за отдельное слово - совершенно нормальное явление в тех условиях, которые приведены Анисией, так что извиняться тут не за что.

Цитата(Unconnected @ 3.03.2009 13:44) *
А решение я проверял.
И еще раз извиняюсь. Я что-то никак не могу врубиться в требования задачи: может ли в файле быть несколько строк? (Анисия, ответь, пожалуйста.) Я проверял на файле с неколькими строками, потому, наверное, и получил не то. Сам не знаю, почему я привязался к многострочным файлам.. наверное, потому, что одной строки в 255 символом слишком уж мало, чтоб носить гордое имя файла)).

Ниже - реализация функции GetWord, о которой я говорил раньше. Файл может содержать много строк (каждая не больше 255 символов. Структура основной программы в целом selfexplainable, но могу дать пояснения, если надо. К функции тоже, конечно smile.gif.
var
f,g: text;
s,t,w: string;
p: byte;

function GetWord: string;
begin
repeat
if s='' then ReadLn(f,s);
while (s<>'')and(s[1]=' ') do Delete(s,1,1);
until (s<>'')or EoF(f);
p:=Pos(' ',s);
if p=0 then p:=Length(s) else Dec(p);
GetWord:=Copy(s,1,p);
Delete(s,1,p)
end;

begin
Assign(f,'in.txt');
ReSet(f);
s:='';
t:='';
repeat
w:=t;
t:=GetWord;
until t='';
ReSet(f);
s:='';
Assign(g,'out.txt');
ReWrite(g);
repeat
t:=GetWord;
if t<>w then Write(g,t,' ')
until t='';
Close(g);
Close(f)
end.
Unconnected
Ага, на многострочных не работает, хотя изначально подразумевалось, что заработает smile.gif

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.