ac自动机+矩阵 poj 2778

ac自动机，令人神往的名字。。。

ac自动机：http://www.cppblog.com/mythit/archive/2009/04/21/80633.html

poj2778：http://hi.baidu.com/%D2%D5%C1%D6010/blog/item/6db06ccf0a3b440993457e7b.html

ac自动机，多模式匹配，学了kmp，tire后，将其融合的算法。

首先建立字典树（tire），运用kmp的思想，构造fail指针。构造方法：将根加入队列，逐层广搜，根的fail指针指向自己，每搜到一个节点，设值为‘A'，访问其祖先的fail指针，

判断其值为'A'的节点是否为空，若不是，则fail指针指向值为‘A’的节点，若是，则继续访问其fail指针，若到根也为找到适合节点，则指向根。匹配时只需设两个指针扫描串和树，

若匹配，则同时后移，若不匹配，则串指针不动，树指针移向fail指针。

poj 2778 给定m个串，要求生成长度为n，不包含该m个串的序列的方案数。

用m个串构造tire树（若某串包含另一串则不加入），与fail指针，将每个节点编号，表示后缀为其到根的状态。构造矩阵，考虑某个节点，当后面添上某字符时，如果有该子节点，

则判断是否是叶子节点（即加入后会成为m串之一），不是，则该节点到其子节点权值加一，是，则不考虑；若无该子节点，则找其fail指针，直到有该子节点，或到根停下，

若有该子节点，则依上一情况讨论，若到根也无该子节点，则该节点到根权值加一。

构造完矩阵，运用矩阵乘法即可。

这道题实际上是用ac自动机转化为图上的路径条数问题，可以在矩阵乘法十道经典题中找到。

const q:array[1..4]of char=('A','C','T','G');
      mo=100000;
type arry=array[0..100,0..100]of int64;
var next:array[0..10000,'A'..'T']of longint;
    pow,st,p:array[0..10000]of longint;
    a,b,mul:arry;
    n,m,ss:longint;
    ans:int64;
procedure link(n:string);
var x,i,l:longint;
begin
 x:=0;i:=1;l:=length(n);
 while i<=l do begin
  if next[x,n[i]]=0 then begin inc(ss);next[x,n[i]]:=ss end;
  x:=next[x,n[i]];
  if pow[x]=1 then exit;
  inc(i)
 end;
 pow[x]:=1
end;
procedure bfs(s:longint);
var h,r,i,ne,na,nr:longint;
    flag:boolean;
begin
 h:=0;r:=1;st[1]:=s;
 repeat
  inc(h);ne:=st[h];
  if ne=6 then
   ne:=ne;
  for i:=1 to 4 do
  if pow[ne]=0 then begin
  if next[ne,q[i]]<>0 then begin
   nr:=ne;
   while p[nr]<>nr do begin
    nr:=p[nr];
    if next[nr,q[i]]<>0 then begin nr:=next[nr,q[i]];break end;
   end;
   p[next[ne,q[i]]]:=nr;pow[next[ne,q[i]]]:=pow[next[ne,q[i]]] or pow[nr];
   inc(r);st[r]:=next[ne,q[i]];

   na:=next[ne,q[i]];flag:=true;
   while na<>p[na] do begin
    if pow[na]=1 then begin flag:=false;break end;
    na:=p[na]
   end;
   if flag then inc(b[ne,next[ne,q[i]]]);
  end
  else begin
   na:=ne;flag:=true;
   while p[na]<>na do begin
    na:=p[na];nr:=next[na,q[i]];
    if nr<>0 then break
   end;
   nr:=next[na,q[i]];
   if pow[nr]=0 then inc(b[ne,nr]);
  end
  end
 until h>=r
end;
procedure mul1;
var i,j,k,e:longint;
begin
 fillchar(mul,sizeof(mul),0);
 for i:=0 to ss do
  for j:=0 to ss do
   for k:=0 to ss do begin
    mul[i,j]:=mul[i,j]+(a[i,k]*b[k,j]);
    IF mul[i,j]>mo then mul[i,j]:=mul[i,j] mod mo
   end;
 for i:=0 to ss do for j:=0 to ss do a[i,j]:=mul[i,j];
end;
procedure mul2;
var i,j,k,e:longint;
begin
 fillchar(mul,sizeof(mul),0);
 for i:=0 to ss do
  for j:=0 to ss do
   for k:=0 to ss do begin
    mul[i,j]:=(mul[i,j]+(b[i,k]*b[k,j]));
    IF mul[i,j]>mo then mul[i,j]:=mul[i,j] mod mo
   end;
 for i:=0 to ss do for j:=0 to ss do b[i,j]:=mul[i,j];
end;
procedure fgm(e:longint);
var i:longint;
begin
 for i:=0 to ss do a[i,i]:=1;
 while e<>0 do begin
  if e and 1=1 then mul1;
  mul2;
  e:=e>>1
 end
end;
procedure init;
var i,j:longint;
    x:string;
begin
 fillchar(b,sizeof(b),0);fillchar(a,sizeof(a),0);
 fillchar(next,sizeof(next),0);fillchar(pow,sizeof(pow),0);
 fillchar(p,sizeof(p),0);fillchar(st,sizeof(st),0);
 readln(m,n);
 for i:=1 to m do begin
  readln(x);link(x)
 end;
 bfs(0);
 fgm(n);
 ans:=0;
 for i:=0 to ss do ans:=(ans+a[0,i]) mod mo;
 writeln(ans mod mo)
end;
begin
assign(input,'2778.in');reset(input);
assign(output,'2778.out');rewrite(output);
 while not seekeof do init;
close(input);close(output)
end.