Строки Опции

[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:string;
   result:array[1..20] of string;
   i,j,k,l,bword,count,count1:integer;
   flag:boolean;

Begin
   clrscr;

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

   i:=1; l:=0;
   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[j] in chars then
             inc(count);

           j:=bword; flag:=false;
           while(j<=i-2)and(not(flag)) do
            begin
               flag:=false; count1:=1;
               k:=j+1;
               while(k<=i-1) do
                begin
                   if (not(s[j] in chars))and(s[j]=s[k]) then
                 inc(count1);
                 inc(k);
                end;
               if count1>count then
                flag:=true
               else
                inc(j);
            end;

           if not flag then
            begin
               inc(l);
               result[l]:=copy(s,bword,i-bword);
            end;
        end;
    end;

    writeln;
    if l<>0 then
    for i:=1 to l do
     write(result[i],'  ')
    else writeln('No');
    readln;
end.

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