Консультации Портала - Консультация #180411

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 180411

22.10.2010, 15:01

0.00 руб.

0 4 2

Компьютеры Программирование

Здравствуйте, уважаемые эксперты!
Помогите, пожалуйста, решить задачу:

Дана строка, в которой содержится осмысленное текстовое сообщение. Слова сообщения разделяются пробелами и знаками препинания. Вывести только те слова, которые встречаются в тексте ровно один раз.

(пользуюсь программой ABC)

Обсуждение

давно

lamed

Академик
320937
2216

22.10.2010, 16:27

общий

Ведь был же сарайчик!

Отвечали уже эксперты на этот вопрос, найти только не удается.

давно

Зенченко Константин Николаевич

Старший Модератор
31795
6196

22.10.2010, 17:52

общий

это ответ

Здравствуйте, verona!

Смотрите приложение.
вопросы задавайте в мини-форум.
Удачи!

Приложение:
var
a,b:string;
begin
write('Enter string:');
readln(a);
{приводим к одному типу разделителей слов}
b:='.,-:;?';
while length(b)>0 do
begin
while pos(b[1],a)>0 do
a[pos(b[1],a)]:=' ';
delete(b,1,1);
end;
{удаляем двойные пробелы}
a:=a + ' ';
while pos(' ',a)>0 do
delete(a,pos(' ',a),1);
{проверяем всю строку}
write('Result:');
while length(a)>0 do
begin
b:=copy(a,1,pos(' ',a));{очередное проверяемое слово}
delete(a,1,pos(' ',a));{удаляем проверяемое слово}
if pos(' '+b,' '+a)=0 then write(' ',b,' '){повторов нет выводим}
else
while pos(' '+b,' '+a)>0 do{удаляем повторные слова}
delete(a,pos(' '+b,' '+a),length(b));
end;
end.

Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

давно

lamed

Академик
320937
2216

22.10.2010, 19:28

общий

Зенченко Константин Николаевич:
И мой скромный вклад. К сожалению, не сразу "дошла" Ваша идея, поэтому пришлось еще немного покорпеть.

Код:

type
  TDelim = set of char;

function FirstWord(s: string; delim: TDelim): string;
// Первое (слева) слово в строке с разделителями
//
var
  i  : integer;
  rez: string;
begin
  i:= 1;
  while s[i] in delim do
    inc(i);

  rez := '';
  while (i<=length(s)) and (not (s[i] in delim)) do
    begin
      rez := rez+s[i];
      inc(i);
    end;
  FirstWord := rez;
end;

function PurePos(subs: string; s: string; delim: TDelim): integer;
// Позиция первого "чистого" вхождения слова в строку
// например, слово <ФОРМА> не входит в строку <ИНФОРМАТИКА>
var
  lenS   : integer; // длина строки
  lenSubs: integer; // длина подстроки
  i      : integer; // счетчик цикла
begin
  lenS    := length(s);
  lenSubs := length(subs);
  PurePos := 0;

  for i:= 1 to lenS-lenSubs+1 do
    begin
      if (copy(s,i,lenSubs)=subs) and
         ((i=1) or (s[i-1] in delim)) and
         ((i=lenS-lenSubs+1) or (s[i+lenSubs] in delim)) then
        begin
          PurePos := i;
          exit;
        end;
    end;
end; { pos }

// Новое
var
  s, wd : string;
  delim : TDelim;
  printed: boolean;
begin
  delim := delim+[',']+[';']+[' '];
  printed:= false;
  write('Enter string:');
  readln(s);

  s:= trim(s);
  if s='' then
    writeln('Sorry, your string is empty')
  else
    begin
      wd := FirstWord(s, delim); // нашли первое слово
      while (wd <> '') do
        begin
          delete(s, PurePos(wd, s, delim), length(wd)); // удалили первое слово
          if (PurePos(wd, s, delim) = 0) then // нет других - печатаем удаленное
            begin
              if printed then // для красивого вывода
                 write(';')
              else
                printed := true;
              write(wd);
            end
          else
            while (PurePos(wd, s, delim)>0) do // удаляем все дубликаты
              delete(s, PurePos(wd, s, delim), length(wd));
          wd := FirstWord(s, delim);
        end;
      if printed then
        writeln
      else
        writeln('there are no unique words');
    end;
end.

Примеры работы

Код:

nter string:папа у васи силен мама у василия
папа;васи;силен;мама;василия
Enter string:инфо инфор
инфо;инфор
Enter string:ин инфо мин
ин;инфо;мин
Enter string:ин пин дин син ин
пин;дин;син
Enter string:123 456 789 1234
123;456;789;1234

давно

lamed

Академик
320937
2216

22.10.2010, 19:52

общий

это ответ

Здравствуйте, verona! Функция pos не "знает" о словах, отделенных от других специальными символами-разделителями.
Функция PurePos выдает ненулевое значение, если искомое слово в строке есть и не является частью какого-либо слова строки
Функция FirstWord возвращает первое найденное слово в строке с разделителями. Если "пусто", значит, в строке нет ничего, кроме разделителей.
Pascal ABC.

Код:

type
  TDelim = set of char;

function FirstWord(s: string; delim: TDelim): string;
// Первое (слева) слово в строке с разделителями
//
var
  i  : integer;
  rez: string;
begin
  i:= 1;
  while s[i] in delim do
    inc(i);

  rez := '';
  while (i<=length(s)) and (not (s[i] in delim)) do
    begin
      rez := rez+s[i];
      inc(i);
    end;
  FirstWord := rez;
end;

function PurePos(subs: string; s: string; delim: TDelim): integer;
// Позиция первого "чистого" вхождения слова в строку
// например, слово <ФОРМА> не входит в строку <ИНФОРМАТИКА>
var
  lenS   : integer; // длина строки
  lenSubs: integer; // длина подстроки
  i      : integer; // счетчик цикла
begin
  lenS    := length(s);
  lenSubs := length(subs);
  PurePos := 0;

  for i:= 1 to lenS-lenSubs+1 do
    begin
      if (copy(s,i,lenSubs)=subs) and
         ((i=1) or (s[i-1] in delim)) and
         ((i=lenS-lenSubs+1) or (s[i+lenSubs] in delim)) then
        begin
          PurePos := i;
          exit;
        end;
    end;
end; { pos }

// Новое
var
  s, wd : string;
  delim : TDelim;
  printed: boolean;
begin
  delim := delim+[',']+[';']+[' '];
  printed:= false;
  write('Enter string:');
  readln(s);

  s:= trim(s);
  if s='' then
    writeln('Sorry, your string is empty')
  else
    begin
      wd := FirstWord(s, delim); // нашли первое слово
      while (wd <> '') do
        begin
          delete(s, PurePos(wd, s, delim), length(wd)); // удалили первое слово
          if (PurePos(wd, s, delim) = 0) then // нет других - печатаем удаленное
            begin
              if printed then // для красивого вывода
                 write(';')
              else
                printed := true;
              write(wd);
            end
          else
            while (PurePos(wd, s, delim)>0) do // удаляем все дубликаты
              delete(s, PurePos(wd, s, delim), length(wd));
          wd := FirstWord(s, delim);
        end;
      if printed then
        writeln
      else
        writeln('there are no unique words');
    end;
end.

Примеры работы

Код:

Enter string:123
123
Enter string:123 123
there are no unique words
Enter string: 
Sorry, your string is empty
Enter string:123;456;1234
123;456;1234

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.