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.