1

Тема: Довгий паліндром

Зенику задано рядок S, який складається з N англійських літер. Потрібно допомогти йому порахувати довжину найбільшого підрядка, який є паліндромом.
  Вхідні дані:
В першому рядку задане одне ціле число N - розмір рядка.
В другому задано рядок S який складається з N малих англійських літер.
Вихідні дані: в єдиному рядку вивести довжину найбільшого підрядка S, який є паліндромом.
    Обмеження: 1<=N<=7000
  Пробний тест:
   N=6
    S=banana
   Результат: 5
Я написав код який на алготестері проходить лише для 10 тестів. Розумію, що при великих кількостях символів він є неефективним. Чув що можна оптимізувати використовуючи алгоритм Манакера про не розумію як це зробити. Ось мій код:

type mas=array[1..7000] of char;

var
   s:mas; palindrom:boolean;
   i,j,mx,n,k,m:integer;
begin
  readln(n);
  for i:=1 to n do 
    read(s[i]);
  if n<2 then 
    mx:=1
  else
  begin
    mx:=1;
    for i:=1 to n-1 do
      for j:=i+1 to n do 
      begin
        palindrom:=true;
        k:=i; 
        m:=j;
        while k<m do 
        begin 
          if s[k]<>s[m] then 
            palindrom:=false;
          k:=k+1;
          m:=m-1
        end;
        if (palindrom=true) and (j-i+1>mx) then
          mx:=j-i+1;
      end;
  end;
  write(mx);
end.

2

Re: Довгий паліндром

Вирівняйте код. Кров з очей не дає прочитати.

3

Re: Довгий паліндром

Порівняв код.

По темі: якщо ви знаєте, що palindrom=false, то нема чого далі крутити цикл while, треба рухатися до наступного j. Це можна зробити звичайним Break-ом, або винісши цикл while в окрему процедуру. Тоді в будь якому місці процедури буде достатньо викликати Exit.

Також раджу створити собі сортований індекс позицій усіх літер в рядку, щось типу такого:

const
  MaxWidth = 7000;

type
  AllowedLetters = 'a'..'z';
  SStr = array [1..MaxWidth] of AllowedLetters;
  LetterPositions = record
    CurFree: Integer;
    Pos: array [1..MaxWidth] of Integer;
  end;
  SIndex = array [AllowedLetters] of LetterPositions;

var
  n: Integer;
  S: SStr;
  Index: SIndex;

procedure AddPosition(var Positions: LetterPositions; CurPos: Integer);
begin
  if Positions.CurFree = 0 then
    Positions.CurFree := 1;
  Positions.Pos[Positions.CurFree] := CurPos;
  Inc(Positions.CurFree);
end;

procedure BuildIndex;
var
  i: Integer;
begin
  for i := 1 to n do
    AddPosition(Index[S[i]], i);
end;

var
  i: Integer;
begin
  readln(n);
  for i := 1 to n do
    read(S[i]);
  BuildIndex;
  //...
end.

В такому індексі позицію наступної потрібної літери знайти дуже легко, замість того, щоб ганяти ваш цикл по j. В даному випадку усі можливі кінці паліндрому перераховані в масиві Index[S[ i ]].Pos, але вас цікавлять лише елементи більші i. До речі, для пошуку таких елементів, ви можете застосувати швидкий бінарний пошук, бо масив Pos сортований.

4

Re: Довгий паліндром

Спробуйте простіше. У вас є три вкладених цикли: по i, по j та по k з m. А достатньо двох: зовнішній по потенційних центрах паліндромів (їх, щоправда, буде удвічі більше - центром може бути як літера, так і місце між літерами залежно від парної чи непарної довжини паліндрома) та внутрішній, на розширення - чи не є це паліндромом. Складність квадратична, а не кубічна, як у вас.

Подякували: Torbins1

5

Re: Довгий паліндром

Тут іще одну оптимізацію можна додати: якщо до кінця S відстань менша ніж половина довжини найбільшого знайденого паліндрома, то далі можна не шукати.

6

Re: Довгий паліндром

Дуже дякую Koala i Torbins використав вашу ідею і пішли всі тести. Ось код:

type
  mas = array[1..7000] of char;

var
  s: mas; palindrom: boolean;
  i, mx, n, k, left, right: integer;

begin
  readln(n);
  for i := 1 to n do read(s[i]);
  if n < 2 then mx := 1
  else
  begin
    mx := 0;
       {для непарних паліндромів}
    for i := 1 to n do 
    begin
      left := i; right := i; palindrom := true; 
      if k > mx then mx := k;
      k := 0;
      while (left >= 1) and (right <= n) and (palindrom = true) do 
      begin
        if s[left] = s[right] then begin
          k := right - left + 1;
          left := left - 1;
          right := right + 1;
          
        end else begin palindrom := false;  end;
      end;
    end;
    
    
                {для парних паліндромів}
    for i := 1 to n - 1 do 
    begin
      left := i; right := i + 1; palindrom := true; 
      if k > mx then mx := k;
      k := 0;
      while (left >= 1) and (right <= n) and (palindrom = true) do 
      begin
        if s[left] = s[right] then begin
          k := k + 2;
          left := left - 1;
          right := right + 1;
        end else palindrom := false;  
      end;
    end;
  end;
  
  
  write(mx);
end.
Подякували: Arete1