uses crt;
var str,substr,maxstr:string;
max:real;
i,kolgl,j:integer;
begin
clrscr;
writeln('Введите строку ');
readln(str);
substr:='';
max:=0;
kolgl:=0;
for i:=1 to length(str) do
begin
if str[i] in ['a'..'z','A'..'Z'] then substr:=substr+str[i]
else
if substr<>'' then
begin
for j:=1 to length(substr) do
if (substr[j] in ['e','u','i','o','a','E','U','I','O','A']) then kolgl:=kolgl+1;
if(kolgl>0)and(max<kolgl/length(substr)) then
begin
max:=kolgl/length(substr);
maxstr:=substr;
end;
substr:='';
kolgl:=0;
end;
end;
writeln(maxstr);
readln;
end.
Следующий вариант
var predl: string; //наше предложение
word: string; //текущее слово
maxword: string; //искомое слово
percent: real; //процент гласных в текущем
maxpercent: real; //процент гласных в искомом
glasn: set of char; //множество гласных букв
letters: set of char; //множество всех букв
ch: char; //очередной символ
i: integer;
wln, gcount: integer; //длина и колво гласных в текущем
begin
glasn := ['A', 'E', 'I', 'U', 'O', 'a', 'e', 'i', 'u', 'o'];
letters := ['A'..'Z', 'a'..'z'];
//заполняем множества
readln(predl);
wln := 0;
gcount := 0;
maxpercent := 0;
maxword := '';
word := '';
for i := 1 to length(predl) do
//пробегаем по всем символам
begin
ch := predl[i];
if ch in letters then
//если очередной символ буква
begin
word := word + ch;
//дописываем сивол к текущему слову
wln := wln + 1;
if ch in glasn then
gcount := gcount + 1;
//увелчиваем колво букв и гласных в текущем
end
else
//если нет то это какой-то разделитель слов
begin
if wln > 0 then
//проверяем не будет ли деления на 0
//такая ситуация может возникнуть если у нас 2 разделителя подряд
begin
percent := gcount / wln;
//вычисляем процент
if (percent > maxpercent) then
begin
maxword := word;
maxpercent := percent;
end;
//сравниваем
wln := 0;
gcount := 0;
word := '';
//начинаем обработку нового слова
end;
end;
end;
if wln > 0 then
begin
percent := gcount / wln;
if (percent > maxpercent) then
begin
maxword := word;
maxpercent := percent;
end;
wln := 0;
gcount := 0;
word := '';
end;
//необходимо для обработки последнего слова, если не в конце не поставлен разделитель
writeln(maxword);
end.
Следующий вариант
program kkk;
uses crt;
const gl:set of char=['A','O','U','I','E','Y'];
var count,i,j,cc,max_num:integer;
st,buf:string;
max:real;
slova:array[1..100]of string;
begin
clrscr;
readln(st);
count:=1;
repeat
if (st[1]=' ') or (length(st)=1) then while st[1]=' ' do delete(st,1,1)
else
begin
while (st[1]<>' ') and (length(st)>1) do
begin
buf:=buf+st[1];
delete(st,1,1);
end;
slova[count]:=buf;
buf:='';
inc(count);
end;
until (length(st)=1) and (length(buf)=0);
max:=-1;
max_num:=0;
for i:=1 to count-1 do
begin
cc:=0;
for j:=1 to length(slova[i]) do if upcase(slova[i][j]) in gl then inc(cc);
if cc>max*length(slova[i]) then
begin
max:=cc/length(slova[i]);
max_num:=i;
end;
end;
if max_num=0 then writeln('Нет таких слов!') else
writeln(slova[max_num]);
readln;
end.
Следующий вариант
program kkk;
uses crt;
const gl:set of char=['A','O','U','I','E','Y'];
var count,i,j,cc,max_num:integer;
st,buf:string;
max:real;
slova:array[1..100]of string;
begin
clrscr;
readln(st);
count:=1;
repeat
if (st[1]=' ') or (length(st)=1) then while st[1]=' ' do delete(st,1,1)
else
begin
while (st[1]<>' ') and (length(st)>1) do
begin
buf:=buf+st[1];
delete(st,1,1);
end;
slova[count]:=buf;
buf:='';
inc(count);
end;
until (length(st)=1) and (length(buf)=0);
for i:=1 to count-1 do
begin
cc:=0;
for j:=1 to length(slova[i]) do if upcase(slova[i][j]) in gl then inc(cc);
writeln(slova[i],' - доля гласных - ',(100*cc/length(slova[i])):0:3),'%');
end;
readln;
end.