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
5.06.2005 12:35
таак опоздал, но вроде исправился :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:
volvo
5.06.2005 12:43
:D Опять не пойдет... Ты же все разделители потеряешь !!! Попробуй:
s := 'dat da da ; net yes ;; yes yes ... no net neta'; count := 2;
1
5.06.2005 19:12
спасибо! а нет ли более простого решения? не учитывая знаки препинания, а только пробелы. вроде бы, решение должно включать в себя: выделение каждого слова, подсчет количества каждого слова в предложении, и, если это количество равно заданному числу, удаление этих слов из строки.
klem4
5.06.2005 19:21
уж куда проще )) я сейчас делаю еще одну версию, мне кажется она буде проще двух предыдущих, сегодня уже надоело, завтра отлаживать буду и выложу, как доделаю...если доделаю конечно ))
Guest
5.06.2005 21:31
тогда ладно...мне завтра уже поздно спасибо огроомное!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.