Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Технологии > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 19.11.2007, 23:45   #1
Алена
 
Регистрация: 01.11.2007
Сообщений: 6
Репутация: 10
По умолчанию В введенном предложении удалить все повторяющиеся слова

В введенном предложении удалить все повторяющиеся слова
Алена вне форума   Ответить с цитированием
Старый 20.11.2007, 00:09   #2
mutabor
Телепат с дипломом
Профессионал
 
Аватар для mutabor
 
Регистрация: 10.06.2007
Сообщений: 4,928
Репутация: 1570

icq: 401708834
По умолчанию

На чем делать?
mutabor вне форума   Ответить с цитированием
Старый 20.11.2007, 00:12   #3
Abbatik
Форумчанин
 
Аватар для Abbatik
 
Регистрация: 11.11.2007
Сообщений: 136
Репутация: 74

icq: 446037211
По умолчанию

Код:

uses crt;
var s:string;
ss:array[1..100] of string;
k,j,n,i:integer;
begin
clrscr;
write('vvedite predlogenie...');
readln(s);
for i:=1 to length(s) do begin
if s[i]=' ' then k:=k+1 else ss[k]:=ss[k]+s[i];
end;
for i:=1 to k do begin
for j:=1 to k do begin
if (ss[i]=ss[j]) and (i<>j) then ss[j]:='';
end;
end;
for i:=1 to k do begin
write(ss[i],' ');
end;
readkey;
end.

слова разделять пробелами
Abbatik вне форума   Ответить с цитированием
Старый 21.11.2007, 11:51   #4
mutabor
Телепат с дипломом
Профессионал
 
Аватар для mutabor
 
Регистрация: 10.06.2007
Сообщений: 4,928
Репутация: 1570

icq: 401708834
По умолчанию

Функция DeleteWords удаляет из предложения повторяющиеся идущие подряд слова.
Параметры:
s: string; //исходная строка
signs: boolean; //необязательный параметр, если True будут учитываться синтаксические знаки ("мама," = "мама")
caps: boolean; //необязательный параметр, если True будет учитываться регистр букв ("Мама" = "мама")

Использование:
Edit2.Text:=DeleteWords(Edit1.Text) ;
Edit2.Text:=DeleteWords(Edit1.Text, True); //учитывать знаки
Edit2.Text:=DeleteWords(Edit1.Text, False,True); //учитывать регистр
Edit2.Text:=DeleteWords(Edit1.Text, True,True); //учитывать знаки и регистр

Код:

function DeleteWords(s: string; signs: boolean = false;
  caps: boolean = false): string;
var
i,w,last: integer;
words: array of string;
begin
last:=-1;
w:=0;
SetLength(words,w+1);

for i:=1 to Length(s) do
  begin
  if s[i]<>' ' then
    begin
    if signs then
      begin
      if not (s[i] in [',', '.', '!', '?']) then
        begin
        words[w]:=words[w]+s[i];
        last:=i;
        end else last:=i;
      end
    else
      begin
      words[w]:=words[w]+s[i];
      last:=i;
      end;
    end
  else
    if last = i-1 then
      begin
      inc(w);
      SetLength(words,w+1);
      end;
  end;

for i:=0 to w-1 do
  if caps then
    begin
    if AnsiLowerCase(words[i]) = AnsiLowerCase(words[i+1]) then words[i]:='';
    end
  else
    if words[i]=words[i+1] then words[i]:='';

for i:=0 to w do
  begin
  Result:=Result + words[i];
  if (i <> w)and(words[i]<>'') then Result:=Result+' ';
  end;
end;


Последний раз редактировалось mutabor; 21.11.2007 в 15:23.
mutabor вне форума   Ответить с цитированием
Старый 21.11.2007, 12:02   #5
Alex21
With best regards
Профессионал
 
Регистрация: 20.04.2007
Адрес: Москва
Сообщений: 1,449
Репутация: 531
По умолчанию

Цитата:
Дано - Edit1, Edit1

результат - Edit1Edit1

Код:

if (s[i]<>',')and(s[i]<>'.')and(s[i]<>'!')and(s[i]<>'?') then

лучше:
if not (s[i] in [',','.','!','?']) then

__________________
Life is too short, play more...
Как правильно задавать вопросы
Alex21 вне форума   Ответить с цитированием
Старый 21.11.2007, 15:12   #6
mutabor
Телепат с дипломом
Профессионал
 
Аватар для mutabor
 
Регистрация: 10.06.2007
Сообщений: 4,928
Репутация: 1570

icq: 401708834
По умолчанию

Спасибо за теситирование, принимается
Код поправил.
Изображения
Тип файла: png proverka.PNG (4.4 Кб, 34 просмотров)

Последний раз редактировалось mutabor; 21.11.2007 в 15:51.
mutabor вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна помощь с алгоритмом расстановки ударения в предложении. Gauss Общие вопросы Delphi 10 14.04.2008 15:31
прога исправляющая маленькую букву в новом предложении. Миха_М Общие вопросы Delphi 8 11.03.2008 11:23
Удалить из массива(одномерного) все повторяющиеся числа(Delphi) Махор Помощь студентам 4 30.11.2007 00:25
Удалить из Memo повторяющиеся строки Etar Компоненты Delphi 2 28.06.2007 18:34
как удалить анти вирус( касперский 2006)если она не работает и ее не возможно удалить Alar Общие вопросы Delphi 0 29.10.2006 22:36


19:55.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru