Cod sursa(job #275)

Utilizator pantaniMarco Pantani pantani Data 8 decembrie 2006 12:22:07
Problema Substr Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.46 kb
program substr;

const filein = 'substr.in';
      fileout = 'substr.out';
      Nmax = 17000;
      infinit= 1000000000; // un miliard

var a : array[0..15,1..Nmax] of longint;
    rmq : array[0..15,1..Nmax] of longint;
    c, b, d, poz, lpref :array[0..Nmax] of longint;
    v : array[0..Nmax] of char;
    coef : array[0..Nmax] of longint;
    N, K, i, j, max_lev, max, rasp : longint;

procedure readdata;
var i : longint;

begin
assign(input, filein); reset(input);
readln(N, K);

for i := 1 to N do
  read(v[i]);

close(input);
end;
{---------------------------------------------------------------------------}

procedure preproc_suffixarrays;
var i, j, put, val_inc, nr, val1, val2 : longint;

begin
for i := 1 to N do
  inc( c[ ord(v[i]) ] );

nr := 0;
for i := 0 to 255 do
  if c[i] > 0 then
    begin
      inc(nr);
      c[i] := nr;
    end;

for i := 1 to N do
  a[0,i] := c[ ord(v[i]) ];

put := 1; max_lev := 1;
while put < N do
  begin
    i := max_lev;

// prima sortare
    fillchar(c, sizeof(c), 0);
    for j := 1 to N do
      begin
        if j > N-put then val_inc := 0
                     else val_inc := a[i-1, j+put];
        inc( c[val_inc]);
      end;

    for j := 1 to N do inc(c[j], c[j-1]);

    for j := 1 to N do
      begin
        if j > N-put then val_inc := 0
                     else val_inc := a[i-1, j+put];
        b[ c[val_inc] ] := j;
        dec( c[val_inc] );
      end;

// a doua sortare
    fillchar(c, sizeof(c), 0);
    for j := 1 to N do
      inc( c[ a[i-1,j] ] );

    for j := 1 to N do
      inc(c[j], c[j-1]);

    for j := N downto 1 do
      begin
        d[ c[ a[i-1,b[j]] ] ]:= b[j];
        dec( c[ a[i-1, b[j] ] ]);
      end;

// construieste ordinea sufixelor
    nr := 1;
    a[i, d[1] ] := 1;
    for j := 2 to N do begin
      if d[j] > N-put then val1 := 0
                      else val1 := a[i-1, d[j]+put];
      if d[j-1] > N-put then val2 := 0
                        else val2 := a[i-1, d[j-1]+put];
      if (a[i-1, d[j-1]]<> a[i-1, d[j]]) or (val1 <> val2) then inc(nr);
      a[i, d[j]] := nr;
    end;

    put := put*2;
    inc(max_lev);

  end;
  dec(max_lev);

end;
{---------------------------------------------------------------------------}

function lcp(a, b : longint) : longint;
var ind, put : longint;

begin
if a > b then
  begin
    a := a xor b;
    b := a xor b;
    a := a xor b;
  end;

ind := coef[b-a];
put := 1 shl ind;

if rmq[ind, a] < rmq[ind, b-put+1] then lcp := rmq[ind,a]
                                   else lcp := rmq[ind, b-put+1];
end;

function minim(x, y : longint):longint;
var k, rez : longint;

begin
  if x = y then
    begin
      minim := N-x+1;
      exit;
    end;

  rez := 0;
  for k := max_lev downto 0 do
    begin
      if a[k, x] = a[k, y] then
        begin
          rez := rez + (1 shl k);
          x := x + (1 shl k);
          y := y + (1 shl k);
        end;
      if (x > N) or (y > N) then break;
    end;

  minim := rez;
end;

procedure preproc_lcp;
var i, lung, niv_max, j, put, nr : longint;

begin
for i := 1 to N do
  poz[ a[max_lev, i] ] := i;

for i := 2 to N do
  lpref[i-1] := minim(poz[i-1], poz[i]);


// construieste RMQ
lung := 1; niv_max := 0;
while lung < N-1 do
  begin
    lung := lung shl 1;
    inc(niv_max);
  end;

for i := 1 to N-1 do
  rmq[0, i] := lpref[i];
for i := N to lung do
  rmq[0, i] := infinit;

put := 2;
for i := 1 to niv_max do
  begin
    for j := 1 to lung-put+1 do
    if rmq[i-1, j] < rmq[i-1, j + (put div 2)]
      then rmq[i, j] := rmq[i-1, j]
      else rmq[i, j] := rmq[i-1, j + (put div 2)];

    for j := lung-put+2 to lung do
      rmq[i,j] := infinit;

    put := put shl 1;
  end;

coef[0] := 0; nr := 0; put := 1;
for i := 1 to lung do
  begin
    if i+1 = put shl 1 then
      begin
        put := put shl 1;
        inc(nr);
      end;
     coef[i] := nr;
  end;

end;
{---------------------------------------------------------------------------}

procedure writedata;
begin
assign(output, fileout);
rewrite(output);

write(max);

close(output);
end;
{---------------------------------------------------------------------------}

begin
readdata;

preproc_suffixarrays;

preproc_lcp;

if K = 1 then
  max := N
else
  for i := 1 to N-K+1 do
    begin
      rasp := lcp(i, i+K-2);
      if rasp > max then
        max := rasp;
    end;

writedata;
end.