Cod sursa(job #60562)

Utilizator gurneySachelarie Bogdan gurney Data 15 mai 2007 14:04:03
Problema ADN Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.15 kb
program adn;
  const
    lmax=30000;
    nmax=18;
    fin='adn.in';
    fout='adn.out';
    max=1 shl (nmax)-1;
  var
    a:array[1..nmax,1..lmax] of char;
    n,i,j,k,x,y:longint;
    ch:char;
    l:array[1..nmax] of integer;
    t:array[0..lmax] of longint;
    b:array[1..nmax,0..max] of longint;
    m,nn:longint;
    viz:array[1..nmax,1..max] of boolean;
    tata:array[1..nmax,1..max] of longint;
    adj:array[1..nmax,1..nmax] of longint;

function log2(x:longint):longint;
  var
    mask:longint;
  begin
    mask:=0;
    while 1 shl (mask+1)<=x do
      inc(mask);
    log2:=mask;
  end;

procedure back(i,x:longint);
  var
    xx,y,k,ind:longint;
  begin
    viz[i,x]:=true;
    y:=x;xx:=x xor (1 shl (i-1));
    while y<>0 do
      begin
        k:=y xor (y and (y-1));
        y:=y and (y-1);
        ind:=trunc(log2(k))+1;
        if ind<>i then
          begin
            if viz[ind,xx]=false then
              back(ind,xx);
            if b[i,x]<b[ind,xx]+adj[i,ind] then
              begin
                b[i,x]:=b[ind,xx]+adj[i,ind];
                tata[i,x]:=ind;
              end;
          end;
      end;
  end;

function count(i:longint):longint;
  var
    k:integer;
  begin
    k:=0;
    while i<>0 do
      begin
        inc(k);
        i:=i and (i-1);
      end;
    count:=k;
  end;

function kmp(i1,i2:integer):longint;
  var
    i,k:longint;
  procedure build_t;
    var
      i,k:longint;
      begin
        t[0]:=0;
        t[1]:=0;
        k:=1;
        for i:=2 to l[i2] do
          begin
            while (k<>0)and(a[i2,i]<>a[i2,k+1]) do
              k:=t[k];
            if k=0 then
              t[i]:=0
            else
              begin
                t[i]:=k+1;
                inc(k);
              end;
          end;
      end;

  begin
    k:=0;
    for i:=1 to l[i1] do
      begin
        if a[i1,i]=a[i2,k+1] then
          inc(k)
        else
          begin
            k:=t[k];
            while (k<>0) and (a[i1,i]<>a[i2,k+1]) do
              k:=t[k];
          end;
      end;
    kmp:=k;
  end;

begin
  assign(input,fin);
    reset(input);
    readln(n);
    for i:=1 to n do
      begin
        while not(seekeoln(input)) do
          begin
            inc(l[i]);
            read(ch);
            a[i,l[i]]:=ch;
          end;
        readln;
      end;
  close(input);
  assign(output,fout);
    rewrite(output);
    for i:=1 to n do
      for j:=1 to n do
        if i<>j then
          adj[i,j]:=kmp(i,j);
    for i:=0 to n-1 do
      begin
        b[i+1,1 shl i]:=0;
        viz[i+1,1 shl i]:=true;
      end;
    for i:=1 to n do
      begin
        back(i,(1 shl n)-1);
        if b[i,(1 shl n)-1]>m then
          begin
            nn:=i;
            m:=b[i,(1 shl n)-1];
          end;
      end;
    y:=(1 shl n)-1;
    for i:=1 to n-1 do
      begin
        x:=adj[nn,tata[nn,y]];
        for j:=1 to l[nn]-x do
          write(a[nn,j]);
        k:=nn;
        nn:=tata[nn,y];
        y:=y xor (1 shl (k-1));
      end;
    for i:=1 to l[nn] do
      write(a[nn,i]);
  close(output);
end.