Для заданого предложения указать долю согласных., Задание - необходимо регить на 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

В чём глюк ?

[volvo]

:o  что тут не то с текстом

В общем так: программа, которую ты привел как неправильную, совершенно рабочая. Все дело - в кривости рук. Смотри внимательно:

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.

Забыл, или не захотел заметить? И сразу же "что-то с кодом"? ДА !!! Но заметь, с ТВОИМ кодом, ты его исправил, так будь добр исправлять до конца !!!

Теперь дальше.

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

Идешь в FAQ и находишь там функцию разбиения строки на слова, это уже обсуждалось десятки раз, выкладывать сюда эту функцию еще раз у меня нет ни малейшего желания... Потом для КАЖДОГО слова (в цикле) проделываешь вот такую простую операцию:

begin
  count := 0; s := _word[i]; { для удобства работы }
  for i := 1 to length(s) do
    if s[i] in soglas then inc(count);
  writeln('в слове №', i, ' процент согласных = ', 100*count/length(s), '%');
end;

где _word - это массив слов, через который функция разбиения строки возвратит результат, а soglas - множество, содержащее все согласные буквы.

А вот для этого:

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

тебе придется еще хранить максимальное значение count, но нахождение максимума "на лету" тоже неоднократно обсуждалось, и элементарно находится в поиске...

[Guest]

count := 0;

чем оно является - ошибка 3

[flashg]

сори выше написанное сообщение моё забыл залогится

[flashg]

сново не получается сделать чтобы считал более 1ной буквы в строке

Код

PROGRAM PR3;
    var s1,s2:string[20];
    n,m,q,r: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);



    BEGIN
   r:=-1;
         read(s2);
     m:=pos('б',s2);
         if m>0 then
     BEGIN
         repeat
                     m:=pos('б',s2);
   r:=r+1;
   delete(s2,m,1);
   until m=0;
   end
   else r:=0;
   write('Кол-во букв б =',r);
    end;

END.

и кажется что подсчёт буква а идёт не по их количество а сколькострок соодержит букву а

а в FAQ (поиск) - я не нашёл заглавия (под темы)
функцию разбиения строки на слова

[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 21:38

[volvo]

а в FAQ (поиск) - я не нашёл заглавия (под темы) функцию разбиения строки на слова

Значит, плохо искал: FAQ: Строки - Разбить на слова

[flashg]

да это я и хотел получить хотя вот тут какое есть сомнение

вот задание (первая часть)

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

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

[volvo]

flashg, прекращай переливать из пустого в порожнее! В посте №2 (между begin и end) содержится то, что тебе нужно для решения задачи. Дальше - самостоятельно. Задание дали ТЕБЕ, а не НАМ !!!

[flashg]

Пост № 6

рассписывает именно то что я хотел добится от первой части задания

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

эта структура (пример) намного удобней при помощи него легче сделать список согласных чем при помощи

Код

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.

или ты хочешь сказать что пост № 6 соодержит не правильный вариант я спомощью данного кода смог заменит буквы (обе буквы) и оно считает а в посте номер 2а

он соодержит код при котором он мне пишет что
а =0
б = 0

хотя буквы данные я вводил - значит глючит данный код.

[klem4]

Вот тебе ЧЕТКОЕ решения по заданию, надеюсь слово с максимальной долей согласных найти сможешь ?

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

uses crt;
type
   Tstr   = string;
   TWords = array[1..50] of TStr;

var
  str:Tstr;
  words:TWords;
  n,j:integer;


function GetWords(var s:Tstr; var W:TWords):integer;
const limits=[#0..#32,'.',',','!','?',':',';'];
var
   i,bword,count:integer;

begin

   i:=1; count:=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);

        inc(count);
        W[count]:=copy(s,bword,i-bword);
    end;
  end;

  GetWords:=count;

end;

function GetP(var s:Tstr):integer;
const
   sogl=[#97..#122]-['q','e','y','u','i','o','a'];
var
   i,p:integer;

begin

   p:=0;

   for i:=1 to length(s) do
    if s[i] in sogl then inc(p);

   GetP:=p*100 div length(s);
end;


Begin

   clrscr;

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

   n:=GetWords(str,words);

   for j:=1 to n do
    writeln('Для слова ''',words[j],''' доля согласных = ',GetP(words[j]),'%');



   readln

End.

[flashg]

Вот тебе ЧЕТКОЕ решения по заданию, надеюсь слово с максимальной долей согласных найти сможешь ?

маленькая проблема - это нормально ли я запустил прогу я ввожу текст

провека задания одинадцать
жму энтер

для всех прописало 0% :o

[klem4]

маленькая проблема - это нормально ли я запустил прогу я ввожу текст

провека задания одинадцать
жму энтер

для всех прописало 0%  :o

по мойму по константе limits можно было понять, что программа раюотает с литиницей, а не кирилицей ...

[flashg]

Да иещё ранее в посте №6 первый код ты мне дал я его рассширел но есть маленькое но

uses crt;
   var
   s:string;
   v_count, b_count, g_count, d_count, j_count, z_count, i:integer;
   k_count, l_count, m_count, n_count, p_count, r_count:integer;
   s_count, t_count, f_count, h_count, ch_count, sh_count, sch_count:integer;
   c_count:integer;
   Begin
   clrscr;
   v_count:=0; b_count:=0; g_count:=0; d_count:=0; j_count:=0; z_count:=0;
   k_count:=0; l_count:=0; m_count:=0; n_count:=0; p_count:=0; r_count:=0;
   s_count:=0; t_count:=0; f_count:=0; h_count:=0; c_count:=0; ch_count:=0;
   sh_count:=0; sch_count:=0; 
   write('s='); readln(s);
   
   
if (pos('б',s)<>0) then
for i:=1 to length(s) do
   
   
   case s[i] of
    'в': inc(v_count);				
      'б': inc(b_count);
      'г': inc(g_count);
      'д': inc(d_count);
      'ж': inc(j_count);
      'з': inc(z_count);
      'к': inc(k_count);
      'л': inc(l_count);
      'м': inc(m_count);
      'н': inc(n_count);
      'п': inc(p_count);
      'р': inc(r_count);
      'с': inc(s_count);
      'т': inc(t_count);
      'ф': inc(f_count);
      'х': inc(h_count);
      'ц': inc(c_count);
      'ч': inc(ch_count);
      'ш': inc(sh_count); 
      'щ': inc(sch_count);



  end;
   writeln('б : ', b_count);
   writeln('в : ', v_count);
   writeln('г : ', g_count);
   writeln('д : ', d_count);
   writeln('ж : ', j_count);
   writeln('з : ', z_count);
   writeln('к : ', k_count);
   writeln('л : ', l_count);
   writeln('м : ', m_count);
   writeln('н : ', n_count);
   writeln('п : ', p_count);
   writeln('р : ', r_count);
   writeln('с : ', s_count);
   writeln('т : ', t_count);
   writeln('ф : ', f_count);
   writeln('х : ', h_count);
   writeln('ц : ', c_count);
   writeln('ч : ', ch_count);
  writeln('ш : ', sh_count);
  writeln('щ : ', sch_count);
 
 readln;
End.

достаточно ввести только этого и он всё посчитает т.е. не надо вводить OR вот что я заметил.

[volvo]

Ну-ну... А для заглавных букв ты ЕЩЕ в 2 раза будешь увеличивать программу?

[flashg]

по мойму по константе limits можно было понять, что программа раюотает с литиницей, а не кирилицей ...

а вообще возможно сделать чтобы кирилицу понимала.

Ну-ну... А для заглавных букв ты ЕЩЕ в 2 раза будешь увеличивать программу?

а есть спсоб лучше

[klem4]

так, помойму мы с тобой оба страшно тупим...могу предложить вот такой вариант, вроде можно еще короче. Щас дам еще варинт без массива.

 uses crt;
var
   s:string;
   a:array[char] of byte;
   i:integer;
   ch:char;

Begin

   clrscr;

   readln(s);

   for i:=1 to length(s) do
    for ch:=#0 to #255 do
     if s[i]=ch then
      inc(a[ch]);

   for ch:=#0 to #255 do
    if a[ch]<>0 then
     writeln(ch,' : ',a[ch]);

    readln;
End.

вот тебе версия без массив :

uses crt;
var
   s,ss:string;
   i,j,count:integer;
Begin

   clrscr;

   readln(s);

   i:=1;
   ss:='';
   while(i<=length(s)-1) do begin
       count:=1;
       for j:=i+1 to length(s) do
        if (s[j]=s[i])and(pos(s[i],ss)=0) then
         inc(count);


       if pos(s[i],ss)=0 then begin
           writeln(s[i],' : ',count);
           ss:=ss+s[i];
       end;
       inc(i);
   end;

    readln;
End.

больше вопросов быть не должно.

Сообщение отредактировано: klem4 - 7.08.2005 0:49

[flashg]

как насчёт примера с долями

Код

uses crt;
type
  Tstr   = string;
  TWords = array[1..50] of TStr;

var
 str:Tstr;
 words:TWords;
 n,j:integer;


function GetWords(var s:Tstr; var W:TWords):integer;
const limits=[#0..#32,'.',',','!','?',':',';'];
var
  i,bword,count:integer;

begin

  i:=1; count:=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);

       inc(count);
       W[count]:=copy(s,bword,i-bword);
   end;
 end;

 GetWords:=count;

end;

function GetP(var s:Tstr):integer;
const

[B][U]sogl=[#224..#256]-['а','е','ё','э','у','ю','и','о','ы','я']; [/U][/B]

var
  i,p:integer;

begin

  p:=0;

  for i:=1 to length(s) do
   if s[i] in sogl then inc(p);

  GetP:=p*100 div length(s);
end;


Begin

  clrscr;

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

  n:=GetWords(str,words);

  for j:=1 to n do
   writeln('Для слова ''',words[j],''' доля согласных = ',GetP(words[j]),'%');



  readln

End.

я думал что надо поменять вот эту строчку а всё равно не воспринимает кирилицу - что ещё надо поменять

[volvo]

sogl=[#224..#256]-['а','е','ё','э','у','ю','и','о','ы','я'];

ты это серьезно? А что, в интервале 'а' .. 'п' согласных букв нет совсем? А ты, между прочим, этот интервал даже не рассматриваешь, он находится раньше символа #224...

Кстати, НАУЧИСЬ уже формулировать вопросы правильно !!! Почему из тебя все надо клещами тянуть? Это, в конце концов, ТВОЕ задание, или нет?

всё равно не воспринимает кирилицу

- Поясни, что это значит... ТЕЛЕПАТОВ ЗДЕСЬ НЕТ !!!

(P.S. Следующий твой неверно сформулированный вопрос приведет к наказанию. Надоело. Каждый раз одно и тоже...)

[flashg]

я набираю тексты (предложения) русскими буквами жму ENTER мне выводит информацию что тексты (слова) соодержат согласных 0%

вот что я имел ввиду под словом - не воспринимает кирилицу.

Бить будете ? :low:

Сообщение отредактировано: flashg - 8.08.2005 1:10