Для заданого предложения указать долю согласных., Задание - необходимо регить на PASCAL Опции

[flashg]

Для каждого слова заданного предложения указать долю согласных. Определить слово в котором доля согласных максимальна.

Задание - необходимо регить на PASCAL на TYRBO или BORLAND.

Я нашёл pas фаил содержащий код программы для нахождения одной буквы в строке

я его немного переделал и теперь он находит две буквы. Но прога сразу увеличелась на 50%

а также у меня нет кода (я не знаю как его прописать) для второй части задания.

Определить слово в котором доля согласных максимальна.

ПОПРАКА

:o что тут не то с текстом
Изначальный код был такой

Код

PROGRAM PR3;
var s1:string[20];
n,q:integer;
BEGIN
   q:=-1;
   writeln('Введите слово (до 20 букв)');
   read(s1);
   n:=pos('А',s1);
   if n>0 then
   BEGIN
       repeat
       n:=pos('А',s1);
       q:=q+1;
       delete(s1,n,1);
       until n=0;
   END
else q:=0;
write('Кол-во букв А =',q);
END.

я решил чуть чуть помеять т.е. большую А на маленькую а - и уже ничего оно верно не считает

Код

PROGRAM PR3;
var s1:string[20];
n,q:integer;
BEGIN
   q:=-1;
   writeln('Введите слово (до 20 букв)');
   read(s1);
   n:=pos('а',s1);
   if n>0 then
   BEGIN
       repeat
       n:=pos('А',s1);
       q:=q+1;
       delete(s1,n,1);
       until n=0;
   END
else q:=0;
write('Кол-во букв а =',q);
END.

а я так надеялся что введу вот такой код

Код

PROGRAM PR3;
var b,g:string[200];
n,q,m,r:integer;
BEGIN
   q:=-1;
   r:=-1;
   writeln('Введите слово');
   read(b);
   read(g);
   n:=pos('г',g);
   m:=pos('б',b);
   if n>0 then

   BEGIN
       repeat
       n:=pos('г',g);
       q:=q+1;
       delete(g,n,1);
       until n=0;
       end
       else q:=0;

   if m>0 then
    BEGIN
    repeat
      m:=pos('б',b);
      r:=r+1;
 delete(b,n,1);
       until m=0;
       end
    else r:=0;

write('Кол-во букв б =',r);
write('Кол-во букв г =',q);
END.

и забив те буквы что мне надо прога мне найдёт те буквы что встречаются и укажет их - и тут 0.
хотя буквы б тут находит а буквы г - прописывает 0

В чём глюк ?

[klem4]

Что-то ты неясное замутил

может так ? ;)

uses crt;
var
   s:string;

   a_count, b_count, i:integer;

Begin

   clrscr;

   a_count:=0; b_count:=0;

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

   if (pos('a',s)<>0)or(pos('b',s)<>0) then

    for i:=1 to length(s) do
     case s[i] of
      'a': inc(a_count);
      'b': inc(b_count);
     end;

   writeln('a : ', a_count);
   writeln('b : ', b_count);

   readln;

End.

хотя конечно можно сделать и pos с удалением элементов из строки.

вариант с POS

uses crt;
var
   s:string;

   a_count, b_count, i:integer;

Begin

   clrscr;

   a_count:=0; b_count:=0;

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

   if (pos('a',s)<>0)or(pos('b',s)<>0) then begin
       while(pos('a',s)<>0) do begin
           i:=pos('a',s);
           delete(s,i,1);
           inc(a_count);
       end;

       while(pos('b',s)<>0) do begin
           i:=pos('b',s);
           delete(s,i,1);
           inc(b_count);
       end;
   end;

   writeln('A : ',a_count);
   writeln('B : ',b_count);


   readln;

End.

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