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[0..200010] of longint;
    v:array[0..500] of boolean;
    j,len,l,r,k,i,n,m,p,tot:longint;
    s,ch:ansistring;

procedure suffix;
  begin
    fillchar(sum,sizeof(sum),0);
    for i:=1 to n do
    begin
      y[i]:=ord(s[i]);
      inc(sum[y[i]]);
    end;
    m:=255;
    for i:=1 to m do
      sum[i]:=sum[i-1]+sum[i];
    for i:=n downto 1 do
    begin
      sa[sum[y[i]]]:=i;
      dec(sum[y[i]]);
    end;
    p:=1;
    rank[sa[1]]:=1;
    for i:=2 to n do
    begin
      if (y[sa[i]]<>y[sa[i-1]]) then inc(p);
      rank[sa[i]]:=p;
    end;
    m:=p;
    j:=1;
    while m<n do
    begin
      fillchar(sum,sizeof(sum),0);
      y:=rank;
      p:=0;
      for i:=n-j+1 to n do
      begin
        inc(p);
        x[p]:=i;
      end;
      for i:=1 to n do
        if sa[i]>j then
        begin
          inc(p);
          x[p]:=sa[i]-j;
        end;

      for i:=1 to n do
      begin
        rank[i]:=y[x[i]];
        inc(sum[rank[i]]);
      end;
      for i:=1 to m do
        inc(sum[i],sum[i-1]);
      for i:=n downto 1 do
      begin
        sa[sum[rank[i]]]:=x[i];
        dec(sum[rank[i]]);
      end;
      p:=1;
      rank[sa[1]]:=1;
      for i:=2 to n do
      begin
        if (y[sa[i]]<>y[sa[i-1]]) or (y[sa[i]+j]<>y[sa[i-1]+j]) then inc(p);
        rank[sa[i]]:=p;
      end;
      m:=p;
      j:=j shl 1;
    end;
    h[1]:=0;
    p:=0;
    for i:=1 to n do
    begin
      if rank[i]=1 then continue;
      j:=sa[rank[i]-1];
      while (i+p<=n) and (j+p<=n) and (s[i+p]=s[j+p]) do inc(p);
      h[rank[i]]:=p;
      if p>0 then dec(p);
    end;
  end;

function solve(l,r:longint):boolean;
  var i,t:longint;
  begin
    fillchar(v,sizeof(v),false);
    t:=0;
    for i:=l to r do
      if (loc[sa[i]]<>-1) then
        if not v[loc[sa[i]]] then
        begin
          inc(t);
          v[loc[sa[i]]]:=true;
        end;
    if t>k shr 1 then exit(true) else exit(false);
  end;

function check(len:longint):boolean;
  var b,e,i:longint;
      fl:boolean;

  begin
    fl:=false;
    b:=1;
    e:=1;
    for i:=2 to n do
    begin
      if h[i]>=len then inc(e)
      else begin
        if solve(b,e) then
        begin
          if not fl then tot:=0;
          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:=0;
        inc(tot);
        fl:=true;
        ans[tot]:=sa[b];
      end;
    end;
    exit(fl);
  end;

begin
  readln(k);
  while k<>0 do
  begin
    s:='';
    r:=0;
    m:=0;
    for i:=1 to k do
    begin
      readln(ch);
      if r<length(ch) then r:=length(ch);
      for j:=1 to length(ch) do
      begin
        inc(m);
        loc[m]:=i;
      end;
      inc(m);
      loc[m]:=-1;
      s:=s+ch+chr(i);
    end;
    n:=length(s);
    suffix;
    l:=1;
    len:=0;
    while l<=r do
    begin
      m:=(l+r) shr 1;
      if check(m) then
      begin
        len:=m;
        l:=m+1;
      end
      else r:=m-1;
    end;
    if k=1 then
    begin
      writeln(s);
      writeln;
    end
    else if len=0 then
    begin
      writeln('?');
      writeln;
    end
    else begin
      for i:=1 to tot do
      begin;
        for j:=ans[i] to ans[i]+len-1 do
          write(s[j]);
        writeln;
      end;
      writeln;
    end;
    readln(k);
  end;
end.