1189: [HNOI2007]紧急疏散evacuate

Description

发生了火警，所有人员需要紧急疏散！假设每个房间是一个N M的矩形区域。每个格子如果是'.'，那么表示这是一块空地；如果是'X'，那么表示这是一面墙，如果是'D'，那么表示这是一扇门，人们可以从这儿撤出房间。已知门一定在房间的边界上，并且边界上不会有空地。最初，每块空地上都有一个人，在疏散的时候，每一秒钟每个人都可以向上下左右四个方向移动一格，当然他也可以站着不动。疏散开始后，每块空地上就没有人数限制了（也就是说每块空地可以同时站无数个人）。但是，由于门很窄，每一秒钟只能有一个人移动到门的位置，一旦移动到门的位置，就表示他已经安全撤离了。现在的问题是：如果希望所有的人安全撤离，最短需要多少时间？或者告知根本不可能。
Input

输入文件第一行是由空格隔开的一对正整数N与M，3<=N <=20，3<=M<=20，以下N行M列描述一个N M的矩阵。其中的元素可为字符'.'、'X'和'D'，且字符间无空格。
Output

只有一个整数K，表示让所有人安全撤离的最短时间，如果不可能撤离，那么输出'impossible'（不包括引号）。
Sample Input

5 5

XXXXX

X...D

XX.XX

X..XX

XXDXX

Sample Output

3

先bfs出最短路，再枚举时间t，用网络流来判断是否可以安全撤离（至于怎么证明它的正确性，我不知道，网上到处都是这样写的）

本来一直纠结在dis这个距离标号，我想继续利用上次的标号，后来发现不行因为断层以后，有的点距离标号变成最大的，就不能再经过它了，当时调了好久的说

const
    fx:array[1..4]of longint=(1,0,-1,0);
    fy:array[1..4]of longint=(0,1,0,-1);
var
    map:array[0..20,0..20]of char;
    node:array[0..20,0..20]of longint;
    f:array[0..20,0..20,0..400]of longint;
    door:array[0..400,0..1]of longint;
    n,m,menn,doorn,tot:longint;
 
procedure init;
var
    i,j:longint;
begin
    readln(n,m);
    for i:=1 to n do
      begin
        for j:=1 to m do
          begin
            read(map[i,j]);
            if map[i,j]='.' then
            begin
              inc(menn);
              inc(tot);
              node[i,j]:=tot;
            end;
            if map[i,j]='D' then
            begin
              inc(doorn);
              door[doorn,0]:=i;
              door[doorn,1]:=j;
              inc(tot);
              node[i,j]:=tot;
            end;
          end;
        readln;
      end;
end;
 
var
    flag,vis:array[0..20,0..20]of boolean;
    x,y:array[0..410]of longint;
 
procedure bfs;
var
    i,j,head,tail:longint;
begin
    fillchar(f,sizeof(f),1<<7);
    fillchar(vis,sizeof(vis),true);
    for i:=1 to doorn do
      begin
        fillchar(flag,sizeof(flag),true);
        f[door[i,0],door[i,1],i]:=0;
        head:=1;
        tail:=1;
        x[1]:=door[i,0];
        y[1]:=door[i,1];
        flag[x[1],y[1]]:=false;
        while head<=tail do
          begin
            for j:=1 to 4 do
              if (x[head]+fx[j]>0)and(x[head]+fx[j]<=n)and(y[head]+fy[j]>0)and(y[head]+fy[j]<=m) then
              if map[x[head]+fx[j],y[head]+fy[j]]='.' then
              if flag[x[head]+fx[j],y[head]+fy[j]] then
              begin
                inc(tail);
                x[tail]:=x[head]+fx[j];
                y[tail]:=y[head]+fy[j];
                vis[x[tail],y[tail]]:=false;
                f[x[tail],y[tail],i]:=f[x[head],y[head],i]+1;
                flag[x[tail],y[tail]]:=false;
              end;
            inc(head);
          end;
      end;
    for i:=1 to n do
      for j:=1 to m do
        if (map[i,j]='.')and(vis[i,j]) then
        begin
          write('impossible');
          halt;
        end;
end;
 
var
    a:array[0..410,0..410]of longint;
    dis,vh,pre,his:array[0..410]of longint;
    flow,time,aug,num,min,hui:longint;
    find:boolean;
 
procedure sap;
var
    i,j,k:longint;
begin
    aug:=maxlongint;
    fillchar(vh,sizeof(vh),0);
    vh[0]:=num+1;
    fillchar(dis,sizeof(dis),0);
    i:=0;
    while dis[0]<=num do
      begin
        his[i]:=aug;
        find:=false;
        for j:=0 to num+1 do
          if (a[i,j]>0)and(dis[i]=dis[j]+1) then
          begin
            find:=true;
            if aug>a[i,j] then aug:=a[i,j];
            pre[j]:=i;
            i:=j;
            if i=hui then
            begin
              inc(flow,aug);
              while i<>0 do
                begin
                  k:=pre[i];
                  inc(a[i,k]);
                  dec(a[k,i]);
                  i:=k;
                end;
              aug:=maxlongint;
            end;
            break;
          end;
        if find then continue;
        min:=num;
        for j:=0 to num+1 do
          if (a[i,j]>0)and(min>dis[j]) then min:=dis[j];
        dec(vh[dis[i]]);
        inc(vh[min+1]);
        if vh[dis[i]]=0 then break;
        dis[i]:=min+1;
        if i<>0 then
        begin
          i:=pre[i];
          aug:=his[i];
        end;
      end;
end;
 
procedure work;
var
    i,j,k:longint;
begin
    num:=menn+doorn+1;
    hui:=num+1;
    for i:=1 to n do
      for j:=1 to m do
        if map[i,j]='.' then inc(a[0,node[i,j]]);
    while flow<menn do
      begin
        inc(time);
        for i:=1 to n do
          for j:=1 to m do
            if map[i,j]='.' then
            for k:=1 to doorn do
              if f[i,j,k]=time then inc(a[node[i,j],node[door[k,0],door[k,1]]]);
        for i:=1 to doorn do
          inc(a[node[door[i,0],door[i,1]],hui]);
        sap;
      end;
    write(time);
end;
 
begin
    init;
    bfs;
    work;
end.