Program PascalGuru;
 
procedure delPROB (var s:string);   {функция удаления пробела}
var  i:integer;
begin
i:=1;
repeat
if copy(s,i,2)='  ' then delete(s,i,1) else inc(i);
until i>length(s);
end;    {---конец функции удаления пробела}
{----------------------------------}
var s,x:string;  {ниже идёт объявление переменных}
    i,j,p,n:integer;
    kolvo:integer;
    A:array[1..50] of string;
    b:boolean;
 
{----------------------------------}
begin
write('Vvedite stroky slov otdelennymi probelami: ');
readln(s);  { считываем исходную строку}
delPROB(s); {удаляем лишние пробелы}
j:=0;   {обнуляем счётчик кол-ва слов}
repeat  {начало  цикла преобразования строки слов - в массив строк}
inc(j); {увеличиваем счётчик кол-ва слов на +1}
p:=pos(' ',s);   {находим позицию пробела}
x:=copy(s,1,p-1);{вычисляем текущее слово}
if p=0 then x:=s;{проверяем - состоит ли строка из 1 слова  }
A[j]:=x; {текущее слово записываем в массив}
delete(s,1,p); {удаляем это слово из строки}
until p=0; {--- конец  цикла преобразования строки слов - в массив строк}
n:=j;
 
writeln;
 
for i:=1 to n do {цикл прохода по всем словам }
begin  b := true; {то что слово повторяется - истина!}
for j:=1 to i-1 do  {цикл прохода по текущую слову }
if A[j]=A[i] then b:=false; { если слово НЕ повторяется - "b"=ЛОЖЬ}
if b then  {если слово повторяется:}
    begin {-----тогда ниже просчитываем сколько этих слов и выводим на экран:}
         kolvo:=1;
         for j:=1 to n do
         if (i<>j) and (A[i]=A[j]) then inc(kolvo);
         writeln(A[i],' = ',kolvo);
    end;
end;
 
 
readln;
end.