【SPOJ1297】Palindrome (SA+RMQ)

  1 const maxn=2419;
  2 
  3 var
  4  x,y,rank,sa,h,c:array[0..maxn] of longint;
  5  s:ansistring;
  6  f:array[0..maxn,0..15] of longint;
  7  t,q,n:longint;
  8 
  9 function max(x,y:longint):longint; begin if x>y then exit(x) else exit(y); end;
 10 function min(x,y:longint):longint; begin if x<y then exit(x) else exit(y); end;
 11 procedure swap(var x,y:longint);var tmp:longint; begin tmp:=x; x:=y;y:=tmp; end;
 12 procedure make;
 13 var i,j,p,tot:longint;
 14 begin
 15  p:=1;
 16  while p<n do
 17   begin
 18    fillchar(c,sizeof(c),0);
 19    for i:= 1 to n-p do y[i]:=rank[i+p];
 20    for i:= n-p+1 to n do y[i]:=0;
 21    for i:= 1 to n do inc(c[y[i]]);
 22    for i:= 1 to n do inc(c[i],c[i-1]);
 23    for i:= 1 to n do
 24     begin
 25      sa[c[y[i]]]:=i;
 26      dec(c[y[i]]);
 27     end;
 28    fillchar(c,sizeof(c),0);
 29    for i:= 1 to n do x[i]:=rank[i];
 30    for i:= 1 to n do inc(c[x[i]]);
 31    for i:= 1 to n do inc(c[i],c[i-1]);
 32    for i:= n downto 1 do
 33     begin
 34      y[sa[i]]:=c[x[sa[i]]];
 35      dec(c[x[sa[i]]]);
 36     end;
 37    for i:= 1 to n do sa[y[i]]:=i;
 38    tot:=1;
 39    rank[sa[1]]:=1;
 40    for i:= 2 to n do
 41     begin
 42      if (x[sa[i]]<>x[sa[i-1]]) or (x[sa[i]+p]<>x[sa[i-1]+p]) then inc(tot);
 43      rank[sa[i]]:=tot;
 44     end;
 45    p:=p<<1;
 46   end;
 47 end;
 48 
 49 procedure makeh;
 50 var i,j,p:longint;
 51 begin
 52  h[1]:=0; p:=0;
 53  for i:= 1 to n do
 54   begin
 55    p:=max(p-1,0);
 56    if rank[i]=1 then continue;
 57    j:=sa[rank[i]-1];
 58    while (i+p<=n) and (j+p<=n) and (s[i+p]=s[j+p]) do inc(p);
 59    h[rank[i]]:=p;
 60   end;
 61 // for i:= 1 to n do write(h[i],‘ ‘);
 62 // writeln;
 63 end;
 64 
 65 procedure rmq;
 66 var i,j:longint;
 67 begin
 68  fillchar(f,sizeof(f),$7f);
 69  for i:= 1 to n do f[i,0]:=h[i];
 70  for i:= 1 to trunc(ln(n)/ln(2)) do
 71   for j:= 1 to n-1<<i+1 do
 72    f[j,i]:=min(f[j,i-1],f[j+1<<(i-1),i-1]);
 73 end;
 74 
 75 function lcp(x,y:longint):longint;
 76 var t:longint;
 77 begin
 78  x:=rank[x]; y:=rank[y];
 79  if x>y then swap(x,y);
 80  if x<y then x:=x+1;
 81  t:=trunc(ln(y-x+1)/ln(2));
 82  exit(min(f[x,t],f[y-1<<t+1,t]));
 83 end;
 84 
 85 procedure init;
 86 var i,j,tot:longint;
 87  ch:char;
 88 begin
 89  readln(s);
 90  s:=s+‘#‘;
 91  for i:= length(s)-1 downto 1 do s:=s+s[i];
 92  n:=length(s);
 93  for i:= 1 to n do x[i]:=ord(s[i]);
 94  fillchar(c,sizeof(c),0);
 95  for i:= 1 to n do inc(c[x[i]]);
 96  for i:= 1 to 180 do inc(c[i],c[i-1]);
 97  for i:= 1 to n do
 98   begin
 99    sa[c[x[i]]]:=i;
100    dec(c[x[i]]);
101   end;
102  rank[sa[1]]:=1;
103  tot:=1;
104  for i:= 2 to n do
105   begin
106    if x[sa[i]]<>x[sa[i-1]] then inc(tot);
107    rank[sa[i]]:=tot;
108   end;
109  make;
110  makeh;
111  rmq;
112 end;
113 
114 procedure solve;
115 var ans,st,i,k:longint;
116 begin
117  ans:=0;st:=0;
118  for i:= 1 to n do
119   begin
120    k:=lcp(i,n-i+1);
121    if k*2-1>ans then
122     begin
123      st:=i-k+1;
124      ans:=k*2-1;
125     end;
126    if i>1 then
127     begin
128      k:=lcp(i,n-i+2);
129      if k*2>ans then
130       begin
131        st:=i-k;
132        ans:=k*2;
133       end;
134     end;
135   end;
136  for i:= st to st+ans-1 do write(s[i]);
137 end;
138 
139 Begin
140  init;
141  solve;
142 End.