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

Const

n=50; { максимальное число различных слов в строке }

del=[' ','.',',',':','; ','-','!','?','/'];

var

mw:array[1 ... n] of string; { найденные слова }

mk:array[1 ... n] of integer; { количество повторений слов }

s, w:string;

i, j, k, l, m:integer;

skip, new_word:boolean;

begin

Write ('Введите текст: ') ;

Readln (s) ;

s:=s+' ';

Write ('Укажите предельное число повторений слова: ') ;

Read (k) ;

l:=Length (s) ;

m:=0;

skip: = (s[1] in del) ;

if skip then w:='' else w:=s[1];

for i:=2 to l do

if s[i] in del then begin

if not skip then begin

{ w содержит очередное найденное слово }

j:=1; new_word:=true;

while (j<=m) and new_word do begin

if w=mw[j] then begin Inc (mk[j]) ; new_word:=false end;

Inc (j)

end;

if new_word then begin Inc (m) ; mw[m]:=w; mk[m]:=1 end;

w:=''; skip:=true

end

end

else

if skip then begin w:=s[i]; skip:=false end

else w:=w+s[i];

{ фраза разобрана и проанализирована }

j:=0; i:=1;

while (i<=m) and (j=0) do begin

if mk[i]>k then j:=i;

Inc (i)

end;

if j>0 then begin

Writeln ('Слова, которые встретились больше, чем ', k,' раз:') ;

Writeln (mw[j]) ;

for i:=j+1 to m do

if mk[i]>k then Writeln (mw[i]) ;

end

else Writeln ('Нет слов, которые встретились больше, чем ', k,' раз.')

end.

Тестовое решение:

Введите текст: еду, еду в чистом поле; колокольчик дин-дин-дин ... страшно, страшно поневоле средь неведомых равнин!

Укажите предельное число повторений слова: 1

Слова, которые встретились больше, чем 1 раз:

еду

дин

страшно

const

z = 30; / / максимально число слов

var

s, w : string;

n, p, i, j, l : integer;

words : array [1 ... z] of string;

kw : array [1 ... z] of integer;

r : boolean;

begin

writeln ('введите строку') ;

readln (s) ;

writeln ('укажите кол-во повторений') ;

readln (n) ;

l : = Length (s) ;

p : = 1;

w : = '';

for i : = 1 to l do

if (s[i] ' ') and (s[i] '.') and (s[i] ',') then

w : = w + s[i]

else

begin

for j : = 1 to p do

if w = words[j] then

begin

kw[j] : = kw[j] + 1;

r : = true;

end;

if not r then

begin

p : = p + 1;

words[p] : = w;

kw[p] : = kw[p] + 1;

end;

w : = '';

r : = false;

end;

for i : = 1 to p do

if kw[i] > n then

writeln (words[i]) ;

end.