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

Ну ладно, вот:
Код:
Var
 W:Array[1..100] of String;
 S:String;
 i,j,N,L,Imax,Lmax:integer;

Function Test_symm(D:String):Boolean;
var
 b:boolean;
 Ld,k:integer;
begin
 Ld:=Length(D);
 k:=0;
 b:=true;
 while b and (k<=(Ld div 2)) do
  begin
   k:=k+1;
   if D[k]<>D[Ld-k+1] then b:=false;
  end;
 Test_symm:=b;
end;

Begin
 Writeln('Enter the string');
 Readln(S);
 L:=Length(S);
 Writeln;
 j:=1;
 i:=0;
 While i<L do
  begin
   W[j]:='';
   while S[i]=' ' do i:=i+1;
   if i<L then
    begin
     while (S[i]<>' ') and (i<=L) do
      begin
       W[j]:=W[j]+S[i];
       i:=i+1;
      end;
    end;
   if i<L then j:=j+1;
  end;
 N:=j;

 Lmax:=0;
 Imax:=0;
 for i:=1 to N do
  if Test_symm(W[i]) and (Length(W[i])>Lmax) then
   begin
    Imax:=i;
    Lmax:=Length(W[i]);
   end;
 if Imax=0 then
  Writeln('String contains no symmetrical words')
 else
  Writeln('Result: '+W[Imax]);
 Readln
End.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

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