Задача на String!, помогите! срочно! Опции

[push]

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

[Altair]

Разбей для начала строку на слова.
разбиение на слова.

[volvo]

klem4, не пойдет... Проверяй строку: 'da da net yes yes yes no net' при count = 2...
Должно остаться 'yes yes yes no', а что остается? ;)

[klem4]

ага, лажа полная ))))))))
буду чинить)))

[volvo]

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

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;

[klem4]

таак опоздал, но вроде исправился :DDDD
уже из принципа решил, надеюсь этоправильно ))) вроде тестил прилично)))

uses crt;
const
   limits=[#0..#32,'.',',','!','?',';'];
var
   x,yes,no:array[1..30] of string;
   s:string;
   i,j,k,l,yy,nn,ycount,ncount,count,count1,bword:integer;
   flag:boolean;

Begin

   clrscr;

   write('s='); readln(s);

   write('count='); readln(count);

   i:=1; j:=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);
           x[j]:=copy(s,bword,i-bword);
        end;
    end;

    ycount:=0; ncount:=0;

    for i:=1 to j do
     begin
        count1:=0;
        for k:=i to j do
         if x[i]=x[k] then
          inc(count1);
        if count1=count then
         begin
            if ycount>0 then
             begin
                flag:=false;
                l:=1;
                while(l<=ycount)and(not(flag)) do
                 if x[i]=yes[l] then
                  flag:=true
                 else inc(l);
                if flag then
                 begin
                    inc(ycount);
                    yes[ycount]:=x[i];
                 end
                else
                 begin
                    inc(ncount);
                    no[ncount]:=x[i];
                 end
             end
              else
               begin
                  inc(ncount);
                  no[ncount]:=x[i];
               end;

         end{c=c}
          else
           begin
              if ncount>0 then
               begin
                  flag:=false;
                  l:=1;
                  while(l<=ncount)and(not(flag)) do
                   if x[i]=no[l] then
                    flag:=true
                   else inc(l);
                  if not(flag) then
                   begin
                      inc(ycount);
                      yes[ycount]:=x[i];
                   end
               end
                  else
                   begin
                      inc(ycount);
                      yes[ycount]:=x[i];
                   end;
           end;
     end;

   for i:=1 to ycount do
    write(yes[i],' ');
   readln;
end.

злая задача :fire:

Сообщение отредактировано: klem4 - 5.06.2005 12:36

[volvo]

:D Опять не пойдет... Ты же все разделители потеряешь !!!
Попробуй:

s := 'dat da da ; net yes ;; yes yes ... no net neta';
count := 2;

[1]

спасибо!
а нет ли более простого решения? не учитывая знаки препинания, а только пробелы.
вроде бы, решение должно включать в себя: выделение каждого слова, подсчет количества каждого слова в предложении, и, если это количество равно заданному числу, удаление этих слов из строки.

[klem4]

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

[Guest]

тогда ладно...мне завтра уже поздно
спасибо огроомное!