VPF::[Pascal] Вывести слова, отличные от последнего

InviZible

Дата 7.10.2006, 12:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 63
Регистрация: 13.9.2006

Репутация: нет
Всего: нет

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

Задача: Вывести на экран те слова, которые отличны от последнего слова текста и первая буква этого слова входит в него ещё раз.

Заранее спасибо.

Тьма

Дата 7.10.2006, 21:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 339
Регистрация: 22.1.2005
Где: Украина, Винница

Репутация: нет
Всего: 4

вычленяешь последнее слово, обрезаешь строку, в цикле выделяешь каждое слово, и проверяешь подходит ли оно условию
функции которые можно использовать:

Код


pos
copy
delete

детальная информация по функциям содержится в справке

--------------------

Vir magni ingenii

InviZible

Дата 8.10.2006, 20:22 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 63
Регистрация: 13.9.2006

Репутация: нет
Всего: нет

а как вычленяеть последнее слово и выделить каждое слово?
и как сравнить буквы в слове между собой?

Это сообщение отредактировал(а) InviZible - 8.10.2006, 20:23

volvo877

Дата 8.10.2006, 20:57 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

Цитата(InviZible @ 8.10.2006, 19:22

)

а как вычленяеть последнее слово и выделить каждое слово?

Поскольку у тебя файл, а не строка, придется запоминать слова в массиве:

Код

const
  delimit = [#0..#32,'.',',',':',';','!','?','"','+','-'];
type
  TWords = array[1..40] of string;

var
  words : TWords;

function GetWords(before: byte; s : string; var w : TWords) : byte;
var
  i, back, n, count: byte;
  st: string;
begin
  i := 1;
  n := before;
  while(i<=length(s)) do begin
    while(i<=length(s)) and (s[i] in delimit) do inc(i);
    if i<=length(s) then begin
      back := i;
      while(i<=length(s)) and not(s[i] in delimit) do inc(i);
      st := copy(s, back, i-back);

      inc(n);
      w[n] := st;
    end;
  end;
  GetWords := n;
end;

var
  f: text;
  s: string;
  n, i: integer;

begin
  n := 0;
  assign(f, 't.txt'); reset(f);
  while not eof(f) do begin
    readln(f, s);
    n := GetWords(n, s, words);
  end;
  close(f);

  for i := 1 to n - 1 do begin

    s := words[i];
    if (s <> words[n]) and (pos(s[1], copy(s, 2, length(s))) > 0)
    then writeln(s);

  end;

end.

(прописные и строчные буквы для программы различны!!! Нужно, чтоб этого различия не было - придется чуть-чуть подкорректировать...)

Это сообщение отредактировал(а) volvo877 - 8.10.2006, 20:59

InviZible

Дата 8.10.2006, 21:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 63
Регистрация: 13.9.2006

Репутация: нет
Всего: нет

offtopic
блин, ну ты и гуру (без иронии и лести). спасибо, может я также через несколько десятков лет научюсь

InviZible

Дата 9.11.2006, 19:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 63
Регистрация: 13.9.2006

Репутация: нет
Всего: нет

Всем спасибо, вот мой вариант

Код


program lr; 
uses crt;
var
 bukvi:set of char;
 f:text;
 slovo,c,s,possl:string;
 pslovo,i,k,j:integer;
 massl:array[1..100] of string;
begin
 clrscr;
 assign(f,'E:/tp7/bin/test/text.txt');
 reset(f);
 bukvi:=['A'..'Z','a'..'z'];
 j:=1;
 writeln('====Text=====================');
 while not eof(f) do
  begin
   readln(f,s);
   writeln(s);
   i:=1;
   while (i <=length(s)) do
    begin
     pslovo:=0;
     if not (s[i] in bukvi) then inc(i);
     slovo:='';
     while (i <=length(s)) and (s[i] in bukvi ) do
      begin
       pslovo:=1;
       slovo:=slovo+s[i];
       inc(i);
      end;
     if pslovo=1 then
      begin
       massl[j]:=slovo;
       inc(j);
      end;
    end;
  end;
 writeln('=============================');
 for i:=1 to j-1 do
  write(massl[i],' ');
  writeln;

 writeln('****last word****************');
 possl:=massl[j-1];
 writeln(possl);
 writeln('*****************************');

 for i:=1 to j do
  begin
   slovo:=massl[i];
   c:=slovo[1];
   delete(slovo,1,1);
   if pos(c,slovo) > 0 then
   begin
    slovo:=c+slovo;
    massl[i]:=slovo;
    if (slovo<>possl) then writeln(slovo);
   end;
  end;
{ writeln(possl); esli nujno pechatat' possl }

 close(f);
 readln;
end.

M
alexeis1

Модератор: не забывайте указывать тип подсветки

Это сообщение отредактировал(а) alexeis1 - 9.11.2006, 21:00

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »