IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача на String!, помогите! срочно!
push
сообщение 4.06.2005 23:48
Сообщение #1


Гость






Нужно удалить из предложения слова, которые встречаются в нем заданное количество раз.
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 5.06.2005 11:35
Сообщение #2


Гость






А вот так вроде работает...

uses crt;
const
  limits=[#0..#32,'.',',','!','?',';'];
  max_str = 30;

var
  x: array[1 .. max_str] of record
    s: string;
    cnt: integer;
  end;

  len, p, ii, x_count: integer;
  b: boolean;

  s: string;
  i, j, count, bword: integer;

Begin
  clrscr;
  write('s='); readln(s);
  write('count='); readln(count);

  i:=1; j:=0;

  x_count := 0;
  while i <= length(s) do begin
    while (i<=length(s)) and (s[i] in limits) do inc(i);
    if i <= length(s) then begin
      bword := i;
      inc(j);
      while (i<=length(s)) and (not(s[i] in limits)) do inc(i);

      b := false;
      p := 1;
      while (p <= x_count) and (not B) do begin
        if x[p].s = copy(s,bword,i-bword) then begin
          inc(x[p].cnt); b := true;
        end;
        inc(p)
      end;

      if not b then begin
        inc(x_count);
        x[x_count].s:=copy(s,bword,i-bword);
        x[x_count].cnt := 1;
      end;
    end;
  end;

  for i := 1 to x_count do
    if x[i].cnt = count then begin
      len := length(x[i].s);
      ii := 1;
      repeat
        p := pos(x[i].s, copy(s, ii, 255)) + pred(ii);
        if (p <> pred(ii)) then begin
          b := true;
          if p > 1 then b := b and (s[p-1] in limits);
          if pred(p)+len < length(s) then
            b := b and (s[p+len] in limits);

          if b then delete(s, p, len)
          else ii := p + len;
        end
      until p = pred(ii);
    end;

  writeln('s=',s);
  readln;
end.

Тестировалось на:
s := 'dat da da net yes yes yes no net neta';
count := 2;
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 1.08.2025 18:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"