Cod sursa(job #1013522)

Utilizator hungntnktpHungntnktp hungntnktp Data 21 octombrie 2013 05:32:38
Problema ADN Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.42 kb
{$H+}
Uses math;
Const
        oo=1000000007;
Type
        mat=array [0..1 shl 18,0..18] of longint;
Var     f,tr,tr1:mat;
        n,res:longint;
        a:array [1..20] of string;
        c:array [1..20,1..20] of longint;
        hash:array [1..20,0..30001] of int64;
        kt:array ['A'..'Z'] of longint;
        mu:array [0..30000] of int64;
        kq:string;
        fi,fo:text;

Procedure Doc;
        Var i:longint;
        Begin
                Readln(fi,n);
                For i:=1 to n do Readln(fi,a[i]);
                kt['A']:=1;
                kt['G']:=2;
                kt['T']:=3;
                kt['C']:=4;
        end;

Function Get(x,i,j:longint):int64;
        Begin
                Get:=(hash[x,j]-(hash[x,i-1]*mu[j-i+1] mod oo)+oo) mod oo;
        end;

Function Count(x,y:longint):longint;
        Var i,k:longint;
        Begin
                For i:=1 to length(a[x]) do
                 Begin
                        k:=length(a[x])-i+1;
                        If k<=length(a[y]) then
                         Begin
                                If Get(x,i,length(a[x]))=Get(y,1,k) then exit(length(a[y])-k);
                         end
                        else
                         Begin
                                If Get(x,i,i+length(a[y])-1)=Get(y,1,length(a[y])) then exit(0);
                         end;
                 end;
                exit(length(a[y]));
        end;

Procedure Khoitao;
        Var i,j:longint;
        Begin
                mu[0]:=1;
                For i:=1 to 30000 do mu[i]:=(mu[i-1]*4) mod oo;
                For i:=1 to n do
                 Begin
                   For j:=1 to length(a[i]) do
                      hash[i,j]:=(hash[i,j-1]*4+kt[a[i][j]]) mod oo;
                 end;
                For i:=1 to n do
                  For j:=1 to n do c[i,j]:=Count(i,j);
        end;


Function Getbit(k,x:longint):longint;
        Begin
                getbit:=(x shr (k-1)) and 1;
        end;


Function Setbit(c,k,x:longint):longint;
        Begin
                If c=1 then Setbit:=x or (1 shl (k-1))
                else Setbit:=x and (not (1 shl (k-1)));
        end;

Procedure Trace;
        Var i,tt,tt1,i1,k,j:longint;
        Begin
                kq:='';
                For i:=1 to n do
                 If res=f[1 shl n-1,i] then break;
                tt:=1 shl n-1;
                Repeat
                        tt1:=tr[tt,i];
                        i1:=tr1[tt,i];
                        If f[tt1,i1]<f[tt,i] then
                         Begin
                                j:=f[tt,i]-f[tt1,i1];
                                For k:=length(a[i]) downto length(a[i])-j+1 do
                                  kq:=kq+a[i][k];
                         end;
                         tt:=tt1;
                         i:=i1;
                        If length(kq)=res then break;
                Until false;
        end;


Procedure Lam;
        Var i,j,tt,tt1:longint;
        Begin
                Khoitao;
                For tt:=0 to 1 shl n-1 do
                  For i:=1 to n do f[tt,i]:=oo;
                For i:=1 to n do
                 Begin
                        tt:=Setbit(1,i,0);
                        f[tt,i]:=length(a[i]);
                 end;
                For tt:=0 to 1 shl n-1 do
                 For i:=1 to n do
                   If f[tt,i]<>oo then
                     For j:=1 to n do
                       If Getbit(j,tt)=0 then
                        Begin
                                tt1:=Setbit(1,j,tt);
                                If f[tt1,j]>f[tt,i]+c[i,j] then
                                 Begin
                                        f[tt1,j]:=f[tt,i]+c[i,j];
                                        tr[tt1,j]:=tt;
                                        tr1[tt1,j]:=i;
                                 end;
                        end;
                res:=oo;
                For i:=1 to n do res:=Min(res,f[1 shl n-1,i]);
                Trace;
                For i:=res downto 1 do Write(fo,kq[i]);
        end;

Procedure Inkq;
        Begin
        end;

        Begin
                Assign(fi,'adn.in');Reset(fi);
                Assign(fo,'adn.out');Rewrite(fo);
                        Doc;
                        Lam;
                        Inkq;
                Close(fo);Close(fi);
        end.