Строки Опции

[MSDDV]

Задача. Дан текст. Группы символов, разделенные пробелами (одним или несколькими) и не содержащиее пробела внутри себя, будем называть словами.
а) Для каждого из слов указать, сколько раз оно всречается среди всех слов, образованных символами данного текста.
б) Найти все слова, содержащие наибольшее количество гласных латинских букв (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.

[klem4]

бэбэп.. может я чот не догоняю , так не проще ? :

uses crt;
const
    limits=[#0..#32,'.',',',';','!','?'];
    chars=['a','e','u','i','o'];

var
   s,result:string;
   i,j,bword,count,max:integer;

Begin
   clrscr;

   write('s='); readln(s);

   i:=1; max:=0; result:='';
   while(i<=length(s)) do
    begin

       while(i<=length(s))and(s[i] in limits) do
        inc(i);

       if(i<=length(s)) then
        begin
           bword:=i;
           while(i<=length(s))and(not(s[i] in limits)) do
            inc(i);
           count:=0;
           for j:=bword to i-1 do
            if s[i] in chars then
             inc(count);

           if (max=0)or(count>max) then
            result:=copy(s,bword,i-bword);

        end;
    end;

    writeln('Result=',result);
    readln;
end.

хмм и по поводу задания, наибольшее кол-во гласных букв может содержать только одно слово, а у остальных может быть только столько-же или меньше.
Так что странное задание

бррр может надо заполнитьмассив из слов, в которых содержания заданных гласных превышает общее колво букв ?

зыы моя прога находит слово,содержащее максимальное вхождение заданных гласных букв

Сообщение отредактировано: klem4 - 8.06.2005 11:55