poj3294

首先后缀数组预处理
然后二分答案len很显然，然后考虑怎么判定
我们用左右指针顺着名次扫描一下，初始左右指针为1
根据LCP(i,j)=min(height[rank[i]+1]~height[rank[j]]) 设rank[i]<rank[j]
移动右指针扫描得到一组后缀[i,j]之间LCP>=len，h[j+1]<len
然后判断一下这组后缀是否有超过半数的原串，如果满足则记录
然后左右指针都从j+1开始
由于每个后缀最多被扫描一次判断一次，所以必然O(n)
注意多个串相连接的时候要用不同的字符作为分隔符

 var ans,x,y,sa,sum,rank,h,loc:array[..] of longint;
     v:array[..] of boolean;
     j,len,l,r,k,i,n,m,p,tot:longint;
     s,ch:ansistring;
 
 procedure suffix;
   begin
     fillchar(sum,sizeof(sum),);
     for i:= to n do
     begin
       y[i]:=ord(s[i]);
       inc(sum[y[i]]);
     end;
     m:=;
     for i:= to m do
       sum[i]:=sum[i-]+sum[i];
     for i:=n downto  do
     begin
       sa[sum[y[i]]]:=i;
       dec(sum[y[i]]);
     end;
     p:=;
     rank[sa[]]:=;
     for i:= to n do
     begin
       if (y[sa[i]]<>y[sa[i-]]) then inc(p);
       rank[sa[i]]:=p;
     end;
     m:=p;
     j:=;
     while m<n do
     begin
       fillchar(sum,sizeof(sum),);
       y:=rank;
       p:=;
       for i:=n-j+ to n do
       begin
         inc(p);
         x[p]:=i;
       end;
       for i:= to n do
         if sa[i]>j then
         begin
           inc(p);
           x[p]:=sa[i]-j;
         end;
 
       for i:= to n do
       begin
         rank[i]:=y[x[i]];
         inc(sum[rank[i]]);
       end;
       for i:= to m do
         inc(sum[i],sum[i-]);
       for i:=n downto  do
       begin
         sa[sum[rank[i]]]:=x[i];
         dec(sum[rank[i]]);
       end;
       p:=;
       rank[sa[]]:=;
       for i:= to n do
       begin
         if (y[sa[i]]<>y[sa[i-]]) or (y[sa[i]+j]<>y[sa[i-]+j]) then inc(p);
         rank[sa[i]]:=p;
       end;
       m:=p;
       j:=j shl ;
     end;
     h[]:=;
     p:=;
     for i:= to n do
     begin
       if rank[i]= then continue;
       j:=sa[rank[i]-];
       while (i+p<=n) and (j+p<=n) and (s[i+p]=s[j+p]) do inc(p);
       h[rank[i]]:=p;
       if p> then dec(p);
     end;
   end;
 
 function solve(l,r:longint):boolean;
   var i,t:longint;
   begin
     fillchar(v,sizeof(v),false);
     t:=;
     for i:=l to r do
       if (loc[sa[i]]<>-) then
         if not v[loc[sa[i]]] then
         begin
           inc(t);
           v[loc[sa[i]]]:=true;
         end;
     if t>k shr  then exit(true) else exit(false);
   end;
 
 function check(len:longint):boolean;
   var b,e,i:longint;
       fl:boolean;
 
   begin
     fl:=false;
     b:=;
     e:=;
     for i:= to n do
     begin
       if h[i]>=len then inc(e)
       else begin
         if solve(b,e) then
         begin
           if not fl then tot:=;
           fl:=true;
           inc(tot);
           ans[tot]:=sa[b];
         end;
         b:=i;
         e:=i;
       end;
     end;
     if b<e then  //注意收尾
     begin
       if solve(b,e) then
       begin
         if not fl then tot:=;
         inc(tot);
         fl:=true;
         ans[tot]:=sa[b];
       end;
     end;
     exit(fl);
   end;
 
 begin
   readln(k);
   while k<> do
   begin
     s:='';
     r:=;
     m:=;
     for i:= to k do
     begin
       readln(ch);
       if r<length(ch) then r:=length(ch);
       for j:= to length(ch) do
       begin
         inc(m);
         loc[m]:=i;
       end;
       inc(m);
       loc[m]:=-;
       s:=s+ch+chr(i);
     end;
     n:=length(s);
     suffix;
     l:=;
     len:=;
     while l<=r do
     begin
       m:=(l+r) shr ;
       if check(m) then
       begin
         len:=m;
         l:=m+;
       end
       else r:=m-;
     end;
     if k= then
     begin
       writeln(s);
       writeln;
     end
     else if len= then
     begin
       writeln('?');
       writeln;
     end
     else begin
       for i:= to tot do
       begin;
         for j:=ans[i] to ans[i]+len- do
           write(s[j]);
         writeln;
       end;
       writeln;
     end;
     readln(k);
   end;
 end.