pku1204 AC自动机

话说又是AC自动机，我据说我掌握的还是很烂。。因为debug很长时间结果样例还是没过，然后找了份标程对着打然后样例过了然后wa掉。。最后通过我的debug终于过了。。

题目大意：

  有个矩阵和n个字符串，问这些字符串在矩阵中出现的位置。总共有八个方向，A代表正北，顺时针依次为B..H。

简略题解：

  关键在于弄清方向，这个很囧。。

  建好AC自动机后按方向匹配就好。

附代码：

program pku_1204; const dx:array[1..8] of longint=(-1,-1,0,1,1, 1, 0,-1); dy:array[1..8] of longint=( 0, 1,1,1,0,-1,-1,-1); df:array[1..8] of longint=(5,6,7,8,1,2,3,4); var ctree:array[0..110000] of record fail,last:longint; son:array['A'..'Z'] of longint; end; a:array[0..1100,0..1100] of char; s:array[0..1100] of char; pre,anx,any,ans:array[0..1100] of longint; zt:array[0..110000] of longint; v:array[0..110000] of boolean; n,m,sum,len,tot:longint; {---------------------------------} procedure insert(x:longint); var i,p:longint; begin p:=1; for i:=len downto 1 do begin if ctree[p].son[s[i]]=0 then begin inc(tot); ctree[p].son[s[i]]:=tot; end; p:=ctree[p].son[s[i]]; end; pre[x]:=ctree[p].last; ctree[p].last:=x; end; {---------------------------------} procedure getfail; var l,r,p,now,i:longint; t:char; begin l:=0;r:=1; zt[1]:=1; while l<r do begin inc(l); now:=zt[l]; for t:='A' to 'Z' do begin p:=ctree[now].son[t]; if p<>0 then begin i:=ctree[now].fail; while (i<>0) and (ctree[i].son[t]=0) do i:=ctree[i].fail; if i=0 then ctree[p].fail:=1 else ctree[p].fail:=ctree[i].son[t]; inc(r); zt[r]:=p; end; end; end; end; {---------------------------------} procedure ackmp(i,j,d:longint); var p,now,l,r:longint; begin now:=1; while (i>=1) and (i<=n) and (j>=1) and (j<=m) do begin p:=ctree[now].son[a[i,j]]; if p<>0 then begin l:=p; while not v[l] do begin r:=ctree[l].last; while r<>0 do begin anx[r]:=i; any[r]:=j; ans[r]:=df[d]; r:=pre[r]; end; v[l]:=true; l:=ctree[l].fail; end; now:=p; inc(i,dx[d]); inc(j,dy[d]); end else begin while (now<>0) and (ctree[now].son[a[i,j]]=0) do now:=ctree[now].fail; if now=0 then begin now:=1; inc(i,dx[d]); inc(j,dy[d]); end; end; end; end; {---------------------------------} procedure init; var i,j:longint; begin fillchar(v,sizeof(v),false); fillchar(ctree,sizeof(ctree),0); tot:=1; readln(n,m,sum); for i:=1 to n do begin for j:=1 to m do read(a[i,j]); readln; end; for i:=1 to sum do begin len:=0; while not eoln do begin inc(len); read(s[len]); end; readln; insert(i); end; end; {---------------------------------} procedure main; var i:longint; begin for i:=1 to n do begin ackmp(i,1,2); ackmp(i,1,3); ackmp(i,1,4); ackmp(i,m,6); ackmp(i,m,7); ackmp(i,m,8); end; for i:=1 to m do begin ackmp(1,i,4); ackmp(1,i,5); ackmp(1,i,6); ackmp(n,i,1); ackmp(n,i,2); ackmp(n,i,8); end; for i:=1 to sum do writeln(anx[i]-1,' ',any[i]-1,' ',chr(ans[i]+64)); end; {---------------------------------} begin init; getfail; main; end.