Задача на файлы. Опции

[Анисия]

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

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, а ты вообще проверяешь свои решения?..

[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 спасибо за помощь, но два часа ковыряний сегодня у меня не прошли даром.

[Lapp]

вот что у меня получилось.
...
два часа ковыряний сегодня у меня не прошли даром.

Это в высшей степени похвально)). Я немного причесал твою прогу (постарайся разобраться с правильным форматированием - это несложно) и написал несколько замечаний.

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 . Только то ли, что надо?}
  close(f);
  close(g);
  readln;
end.

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

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

Не обращай внимания на мое брюзжание)), делай как делается. Покажи, что получится еще через два часа..

[Анисия]

Правильно сказали, я не то совсем нахожу...... спасибо за подсказку буду дальше делать.

[Unconnected]

не обрабатываются пробелы перед/после дефиса
и что за пробелы такие перед/после дефиса?..

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

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

abc defg hig klm nopqr

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

abc
defg
hig klm

Вот что не в строку пишет это да.

[Lapp]

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

Я извиняюсь за излишние придирки, я хотел сказать, что то, что ты имеешь в виду называется в русском языке "тире" (хлеб - всему голова), а дефис соединяет два слова (как-то, сильно-пресильно) и никаких пробелов при нем в принципе быть не может. Правда, в обычном компьютерном тексте (txt) оба они как правило представлены одним символом (минусом), так что различимы только по контексту. Еще раз извиняюсь, я понимаю, что это форум не филологов..

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

А решение я проверял.

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

Ниже - реализация функции GetWord, о которой я говорил раньше. Файл может содержать много строк (каждая не больше 255 символов. Структура основной программы в целом selfexplainable, но могу дать пояснения, если надо. К функции тоже, конечно .

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.

Сообщение отредактировано: Lapp - 3.03.2009 18:48

[Unconnected]

Ага, на многострочных не работает, хотя изначально подразумевалось, что заработает