Правила форума
Прочтите прежде чем задавать вопрос!
а) Для каждого из слов указать, сколько раз оно всречается среди всех слов, образованных символами данного текста.
б) Найти все слова, содержащие наибольшее количество гласных латинских букв (a, e, i, o, u).
в) Найти все слова, в которых доля букв a, b максимальна.
г) В тех словах, которые оканчиваются сочтетанием букв ing, заменить это окончание на ed.
Условия под а и б есть, помогите с в и г
вот код
Uses Crt;
const
max_word = 200; максимальное количество символов
Var word
: array[0..max_word] of string;
count
: array[0..max_word] of byte;
procedure add_word(s : string);
var
i
: byte;
begin
if s = ''
then
exit;
i := 0;
while word[i] <> '' do
begin
if s = word[i]
then
begin
inc(count[i]);
exit;
end;
inc(i);
end;
word [i] := s;
count[i] := 1;
word [i+1] := '';
end;
procedure make(text : string);
var
temp
: string;
i
: byte;
begin
word[0] := '';
temp := '';
for i := 1 to length(text) do
begin
if text[i] = ' '
then
begin
add_word(temp);
temp := ' '
end;
temp := temp + text[i];
end;
add_word(temp);
end;
function calc: byte;
var
n,
i,
max : byte;
begin
n := 0;
max := 0;
while word[n] <> '' do
begin
count[n] := 0;
for i := 1 to length(word[n]) do
if word[n][i] in ['a', 'e', 'i', 'o', 'u']
then
inc(count[n]);
if count[n] > max
then
max := count[n];
inc(n);
end;
calc := max;
end;
Var
i, max
: byte;
text
: string;
Begin
ClrScr;
WriteLn ('Введите текст:'); readln(text); make(text);
i := 0;
while word[i] <> '' do begin
writeln( 'Слово ', word[i], ' встречается - ', count[i],
' раз(а)');
inc(i);
end;
readln;
max := calc;
if max <> 0
then
begin
writeln('Максимальное количиство латинских букв (a, e, i, o, u) ',
max, ' находится в слове :');
i := 0;
while word[i] <> '' do
begin
if count[i] = max
then
writeln('''', word[i], '''');
inc(i);
end;
end;
readln;
End.
