Var count: array[1..26] of integer;

letters: array[1..26] of char;

s: string;

temp: char;

I, k: integer;

begin

for i:=1 to 26 do begin

count[i]:=0;

letters[i]:=Chr(Ord('a')+i-1);

end;

{ чтение данных, подсчёт начальных букв }

while True do begin

readln(s);

if (Length(s) > 0) and (s[1] = '*') then break;

s := ' ' + s;

for i:=1 to Length(s)-1 do

if (s[i] = ' ') and (s[i+1] in ['a'..'z']) then begin

k:=Ord(s[i+1]) - Ord('a') + 1;

count[k] := count[k] + 1;

end;

end;

{ сортировка }

for i:=1 to 26 do begin

for k:=25 downto i do begin

if count[k] < count[k+1] then begin

i:= count[k]; count[k]:= count[k+1]; count[k+1]:= i;

temp:= letters[k]; letters[k]:=letters[k+1];

letters[k+1]:=temp;

end;

end;

end;

{ вывод результата }

for i:=1 to 26 do

if count[i] > 0 then

writeln(letters[i], ' ', count[i]);

end.

Теперь рассмотрим второй вариант ввода данных – посимвольное чтение. Начало слова – это ситуация, когда предыдущий символ (в программе он хранится в переменной c1) – пробел, а следующий за ним – строчная латинская буква. В этом фрагменте c и c1 – переменные типа char:

c1:=' ';

repeat

read(c);

if (c1 = ' ') and (c in ['a'..'z']) then begin

k:=Ord(c) - Ord('a') + 1;

count[k] := count[k] + 1;

end;

c1 := c;

if c in [#10,#13] then c1 := ' '; { перевод строки }

until c = '*';

Первая строчка в этом фрагменте нужна для того, чтобы обработать самое первое слово, перед которым может не быть пробелов – мы искусственно добавляем первый пробел, записывая его в переменную c1.

Строчка

if c in [#10,#13] then c1 := ' '; { перевод строки }

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

Вот полная программа:

Var count: array[1..26] of integer;

letters: array[1..26] of char;

s: string;

c, c1, temp: char;

I, k: integer;

begin

for i:=1 to 26 do begin

count[i]:=0;

letters[i]:=Chr(Ord('a')+i-1);

end;

{ чтение данных, подсчёт начальных букв }

c1:=' ';

repeat

read(c);

if (c1 = ' ') and (c in ['a'..'z']) then begin

k:=Ord(c) - Ord('a') + 1;

count[k] := count[k] + 1;

end;

c1 := c;

if c in [#10,#13] then c1 := ' '; { перевод строки }

until c = '*';

{ сортировка }

for i:=1 to 26 do begin

for k:=25 downto i do begin

if count[k] < count[k+1] then begin

i:= count[k]; count[k]:= count[k+1]; count[k+1]:= i;

temp:= letters[k]; letters[k]:=letters[k+1];

letters[k+1]:=temp;

end;

end;

end;

{ вывод результата }

for i:=1 to 26 do

if count[i] > 0 then

writeln(letters[i], ' ', count[i]);

end.

Наконец, можно использровать массив структур вместо двух массивов count и letters:

type structW = record

count: integer;

letter: char;

end;