Помогите, пожалуйста, решить три задачи по Pascal

[МишаняИАТ]

Помогите, пожалуйста, решить три задачи по Pascal

Задача №1
Определить, сколько раз в строке встречается заданное слово.

Задача№2
Дан текст на русском языке. Напечатать в алфавитном порядке все звонкие согласные буквы, которые входят в каждое нечётное слово и не входят ни в одно чётное слово.

Задача№3
На конкурсе красоты регистрируются участники. Создать массив из 5 записей.
Структура записи:
Ф.И.О. участника конкурса
рост
вес
объём талии

Выбрать в этом массиве записи и выдать на экран Ф.И.О. тех участников, параметры которых соответствуют таким эталонам:
рост 165-175
вес 56-59
объём талии 60-64.

Оооочень нужно):tehnari_ru_281:

 

[Vladimir_S]

Задача №1 Определить, сколько раз в строке встречается заданное слово.

К сожалению, сформулировано нечетко, поэтому два варианта решения.
1. Если учитываются ситуации, когда заданное слово совпадает с частью слова из строки (напр. "cat" - заданное, "tomcat" - есть в строке), то так:

VAR
 S,W:String;
 N,p:Byte;
BEGIN
 Writeln('Enter the string:');
 Readln(S);
 Writeln('Enter the word:');
 Readln(W);
 N:=0;
 Repeat
  p:=Pos(W,S);
  If p>0 then
   begin
    Inc(N);
    Delete(S,p,Length(W));
   end;
 Until p=0;
 Writeln(N,' times');
 Readln;
END.

2. Если предполагается только совпадение целых слов (в строке разделенных пробелами), то так:

VAR
 S,W:String;
 i,i1,i2,N,T:Byte;
 Wr:Array[1..100] of String;

BEGIN
 WriteLn('Enter the string:');
 ReadLn(S);
 Writeln('Enter the word:');
 Readln(W);

 i:=0;
 N:=0;
 Repeat
  Repeat
   Inc(i);
  Until S[i]<>' ';
  i1:=i;
  While (S[i]<>' ') and (i<Length(S)) do
   Inc(i);
  If i=Length(S) then i2:=i else i2:=i-1;
  Inc(N);
  Wr[N]:=Copy(S,i1,i2-i1+1);
 Until i=Length(S);

 T:=0;
 For i:=1 to N do
  If Wr[i]=W then Inc(T);
 Writeln(T,' times');
 Readln;
END.

 

[МишаняИАТ]

Ок) спасибо) а остальные не знаете как решить?

 

[Vladimir_S]

Ок) спасибо) а остальные не знаете как решить?

Знаю. Со звонкими согласными - попробую. Хотя, честно говоря, ненавижу возиться с кириллицей из-за проблем с кодировками (я работаю только с DOS-Паскалем). А вот последней точно заниматься не буду. Сейчас наш форум буквально завален однотипными задачами на составление и обработку баз данных на основе массивов записей. Все эти задачи ни малейшей сложности, равно как и интереса, не представляют, просто рутинные учебные упражнения, а с другой стороны - требуют большого объема тупой однообразной черновой работы. Потому это - без меня, пожалуйста. Тем более, что решение нескольких подобных задач на форуме имеется, причем среди недавних тем, так что шаблон есть, остальное - будьте любезны самостоятельно. Успеха! Но если что-то не будет получаться - мы всегда поможем. А писать кучу программ по теме "массивы записей" с чистого листа - увольте.

 

[Vladimir_S]

Задача№2 Дан текст на русском языке. Напечатать в алфавитном порядке все звонкие согласные буквы, которые входят в каждое нечётное слово и не входят ни в одно чётное слово.

CONST
 Sogl:Array[1..10] of Char=('б','в','г','д','ж','з','л','м','н','р');
VAR
 S:String;
 i,j,k,i1,i2,N,T,N_even,N_odd,Sum_even,Sum_odd:Byte;
 W:Array[1..100] of String;
 M:Array[1..100,1..10] of Byte;
 b:Boolean;

BEGIN
 WriteLn('Enter the string:');
 ReadLn(S);

 i:=0;
 N:=0;
 Repeat
  Repeat
   Inc(i);
  Until S[i]<>' ';
  i1:=i;
  While (S[i]<>' ') and (i<Length(S)) do
   Inc(i);
  If i=Length(S) then i2:=i else i2:=i-1;
  Inc(N);
  W[N]:=Copy(S,i1,i2-i1+1);
 Until i=Length(S);

 For i:=1 to N do
  For j:=1 to 10 do
   begin
    k:=0;
    b:=false;
    Repeat
     Inc(k);
     If W[i][k]=Sogl[j] then b:=true;
    Until b or (k=Length(W[i]));
    If b then M[i,j]:=1 else M[i,j]:=0;
   end;

 Writeln('Входят во все нечетные и не входят ни в одно четное бувы:');
 N_even:= N div 2;
 If (N mod 2)=0 then N_odd:=N_even else N_odd:=N_even+1;
 b:=true;
 For j:=1 to 10 do
  begin
   Sum_odd:=0;
   Sum_even:=0;
   For i:=1 to N do
    If (i mod 2)=0 then
     Sum_even:=Sum_even+M[i,j]
    else
     Sum_odd:=Sum_odd+M[i,j];
   If (Sum_odd=N_odd) and (Sum_even=0) then
    begin
     b:=false;
     Write(Sogl[j]+' ');
    end;
  end;
 Writeln;
 If b then Writeln('Таких букв нет!');
 Readln;
END.

Да... красивая задачка!