bzoj 1066 最大流

/**************************************************************
Problem: 1066
User: BLADEVIL
Language: Pascal
Result: Accepted
Time:48 ms
Memory:2748 kb
****************************************************************/

//By BLADEVIL
var
r, c, d                             :longint;
map, jump                           :array[0..300,0..300] of char;
pre, other, len                     :array[0..100010] of longint;
last                                :array[0..10100] of longint;
num                                 :array[0..300,0..300] of longint;
source, sink                        :longint;
l                                   :longint;
que, dis                            :array[0..100000] of longint;
ans, sum                            :longint;

function min(a,b:longint):longint;
begin
if a>b then min:=b else min:=a;
end;

procedure connect(x,y,z:longint);
begin
inc(l);
pre[l]:=last[x];
last[x]:=l;
other[l]:=y;
len[l]:=z;
end;

procedure init;
var
i, j, ii, jj                        :longint;
k                                   :longint;

begin
readln(r,c,d); l:=1;
for i:=1 to r do
begin
for j:=1 to c do
read(map[i,j]);
readln;
end;

for i:=1 to r do
begin
for j:=1 to c do read(jump[i,j]);
readln;
end;

for i:=1 to r do
for j:=1 to c do num[i,j]:=c*(i-1)+j;
source:=2*r*c+2; sink:=source+1;

for i:=1 to r do
for j:=1 to c do
if jump[i,j]='L' then
begin
connect(source,num[i,j],1);
connect(num[i,j],source,0);
inc(sum);
end;

for i:=1 to r do
for j:=1 to c do
if map[i,j]<>'0' then
begin
for ii:=1 to r do
for jj:=1 to c do
//if (i<>ii) or (j<>jj) then
begin
if (sqrt((i-ii)*(i-ii)+(j-jj)*(j-jj))<=d) then
begin
connect(num[i,j]+r*c,num[ii,jj],maxlongint div 10);
connect(num[ii,jj],num[i,j]+r*c,0);
end;
end;
end;

for i:=1 to d do
for j:=1 to c do
if map[i,j]<>'0' then
begin
connect(num[i,j]+r*c,sink,maxlongint div 10);
connect(sink,num[i,j]+r*c,0);
end;
for i:=r-d+1 to r do
for j:=1 to c do
if map[i,j]<>'0' then
begin
connect(num[i,j]+r*c,sink,maxlongint div 10);
connect(sink,num[i,j]+r*c,0);
end;
for i:=1 to r do
for j:=1 to d do
if map[i,j]<>'0' then
begin
connect(num[i,j]+r*c,sink,maxlongint div 10);
connect(sink,num[i,j]+r*c,0);
end;

for i:=1 to r do
for j:=c-d+1 to c do
if map[i,j]<>'0' then
begin
connect(num[i,j]+r*c,sink,maxlongint div 10);
connect(sink,num[i,j]+r*c,0);
end;
for i:=1 to r do
for j:=1 to c do
if map[i,j]<>'0' then
begin
k:=ord(map[i,j])-48;
connect(num[i,j],num[i,j]+r*c,k);
connect(num[i,j]+r*c,num[i,j],0);
end;
end;

function bfs:boolean;
var
h, t, cur                           :longint;
q, p                                :longint;
begin
fillchar(dis,sizeof(dis),0);
h:=0; t:=1;
que[1]:=source; dis[source]:=1;
while h<t do
begin
inc(h);
cur:=que[h];
q:=last[cur];
while q<>0 do
begin
p:=other[q];
if (len[q]>0) and (dis[p]=0) then
begin
inc(t);
que[t]:=p;
dis[p]:=dis[cur]+1;
if p=sink then exit(true);
end;
q:=pre[q];
end;
end;
exit(false);
end;

function dinic(x,flow:longint):longint;
var
tmp, rest                           :longint;
q, p                                :longint;
begin
if x=sink then exit(flow);
rest:=flow;
q:=last[x];
while q<>0 do
begin
p:=other[q];
if (dis[x]=dis[p]-1) and (len[q]>0) and (rest>0) then
begin
tmp:=dinic(p,min(rest,len[q]));
dec(rest,tmp);
dec(len[q],tmp);
inc(len[q xor 1],tmp);
end;
q:=pre[q];
end;
exit(flow-rest);
end;

procedure main;
begin
while bfs do
ans:=ans+dinic(source,maxlongint div 10);
writeln(sum-ans);
end;

begin
init;
main;
end.