Показать сообщение отдельно
Старый 21.05.2014, 16:04   #5 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

А вообще - ладно, . Да и задачка уж больно забавная. Держите:
Код:
Type
 SC=Set of Char;

Const
  Sonants:SC=['б','в','г','д','ж','з','л','м','н','р'];

Var
 W:Array[1..40] of SC;
 S:String;
 C:Char;
 i,j,N,L:integer;
 Found:SC;
 b1,b2:boolean;

Begin
 Writeln('Введите строку:');
 Readln(S);
 L:=Length(S);
 Writeln;
 j:=1;
 i:=0;
 Repeat
  W[j]:=[];
  repeat
   Inc(i);
   If (S[i]<>',') and (i<L) and (S[i] in Sonants) and not (S[i] in W[j]) then
    W[j]:=W[j]+[S[i]];
  until (S[i]=',') or (i=L);
  if i<L then Inc(j);
 Until i=L;
 N:=j;
 Found:=[];
 for C:='б' to 'р' do
  begin
   b1:=false;
   for j:=1 to N do
    if (j mod 2)=1 then
     if C in W[j] then b1:=true;
   if b1 then
    begin
     b2:=false;
     for j:=1 to N do
      if (j mod 2)=0 then
       if not (C in W[j]) then b2:=true;
    end;
   if b1 and b2 and not (C in Found) then Found:=Found+[C];
  end;

 If Found=[] then
  Writeln('Таких букв нет!')
 else
  begin
   Writeln('Результат:');
   for C:='б' to 'р' do
    if C in Found then write(C+' ');
  end;
 Readln
End.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070