I and OI
Past...
const maxn=100;
      maxm=trunc(ln(maxn)/ln(2))+1;
var   h,sa,rank,tmp,tax:array[0..maxn*2]of longint;
      f:array[0..maxn,0..maxm] of longint;
      t:array['@'..'z']of longint;
      s:array[0..maxn]of char;
      len:longint;

      function max(a,b:longint):longint;
      begin if a<b then exit(b); exit(a); end;

      function min(a,b:longint):longint;
      begin if a>b then exit(b); exit(a); end;

      function lg(num:longint):longint;
      begin
            exit(trunc(ln(num)/ln(2)));
      end;

      procedure sort(u:longint);
      var   x:longint;
      begin
            for x:=0 to len do tax[x]:=0;
            for x:=1 to len do inc(tax[rank[sa[x]+u]]);
            for x:=1 to len do inc(tax[x],tax[x-1]);
            for x:=len downto 1 do
            begin
                  tmp[tax[rank[sa[x]+u]]]:=sa[x];
                  dec(tax[rank[sa[x]+u]]);
            end;
            sa:=tmp;
      end;

      function incr(j,k:longint):longint;
      begin
            exit(ord((rank[sa[j]+k]<>rank[sa[j-1]+k])
                     or(rank[sa[j]]<>rank[sa[j-1]])));
      end;

      procedure MakeSA;
      var   i,j,k:longint;
            ch:char;
      begin
            for ch:='A'to 'z' do t[ch]:=t[pred(ch)]+t[ch] xor 0;
            for i:=1 to len do rank[i]:=t[s[i]];
            for i:=1 to lg(2*len-1) do
            begin
                  k:=1<<(i-1);
                  for j:=1 to len do sa[j]:=j;
                  sort(k); sort(0);
                  for j:=1 to len do
                     tmp[sa[j]]:=tmp[sa[j-1]]+incr(j,k);
                  rank:=tmp;
                  if rank[sa[len]]=len then break;
            end;
      end;

      procedure BuildH;
      var   i,j,k:longint;
      begin
            for i:=1 to len do
               if rank[i]<>len then
               begin
                     j:=rank[i];
                     k:=sa[j+1];
                     while s[h[j]+i]=s[h[j]+k] do inc(h[j]);
                     h[rank[i+1]]:=max(h[j]-1,0);
               end;
      end;

      procedure CalLCP;
      var   i,j:longint;
      begin
            for i:=1 to len do f[i,0]:=h[i];
            for j:=1 to lg(len) do
               for i:=1 to len-(1<<j)+1 do
               f[i,j]:=min(f[i,j-1],f[i+(1<<(j-1)),j-1]);
      end;

      procedure swap(var a,b:longint);
      var   w:longint;
      begin w:=a; a:=b; b:=w; end;

      function LCP(l,r:longint):longint;
      var   k:longint;
      begin
            if l=r then exit(len-l+1);
            if rank[l]>rank[r] then swap(l,r);
            l:=rank[l];
            r:=rank[r]-1;
            k:=lg(r-l+1);
            LCP:=min(f[l,k],f[r-(1<<k)+1,k]);
      end;

      procedure Readst;
      begin
            while not eoln do
            begin
                  inc(len); read(s[len]); t[s[len]]:=1;
            end;
      end;
begin
      Readst;
      MakeSA;
      BuildH;
      CalLCP;
end.

posted on 2011-09-25 17:23  exponent  阅读(616)  评论(0编辑  收藏  举报