bzoj 2668 费用流

  我们可以把初始状态转化为目标状态这一约束转化为将黑子移动到目标状态所需要的最少步数。

  除了初始点和目标点之外,剩下的点如果被经过那么就会被交换两次,所以我们将一个点拆成3个点,a,b,c,新建附加源点source汇点sink。设每个点的交换次数为num[i],那么这个点的交换次数如果是奇数其实是没用的,那么我们连接(a,b,num[i] div 2,0),(b,c,num[i] div 2,0),这样代表这个点一共可以被经过num[i] div 2次,那么对于起始点和终点来说,因为不用被经过,所以原来是奇数的话可以走num[i] div 2+1次,所以(a,b,(num[i]+1) div 2,0),(b,c,(num[i]+1) div 2)。对于两个相邻的点(八连通)连接(ci,aj,inf,1)代表随意经过(每个点的经过次数在拆的点内被限制了,这里不用限制)1次需要1的代价。再连接每个初始状态上的黑点(source,b,1,0),连接每个目标状态上的黑点(b,sink,1,0),代表出发点。

  需要注意的细节是如果一个点目标状态和初始状态相同,那么会出现这样一种情况:source连接b,b连接sink,然后着两条边可以相当于没有,但是a连b,b连c的流量是(num[i]+1) div 2。这代表原来+1是因为到这个点之后停止,不需要再流出(经过),所以奇数的话可以多走一次。现在这个点因为源汇的直接连接使得这个点和普通路径上的点相同,那么就不应该+1,所以我们可以处理初始状态和目标状态上的相同的点,直接不考虑,连接的流量也是(num[i]) div 2。还有一种处理方法就是对于初始状态上的点连接(a,b,num[i] div 2,0),(b,c,(num[i]+1) div 2)目标状态上的点连接(a,b,(num[i]+1) div 2,0),(b,c,num[i] div 2)分别代表可以多进入(出去)一次,这一次是直接从source(sink)流入(流出)的。这两种方法都可以解决这一问题。

  对于无解,有两种情况,第一个是初始状态目标状态上的黑点个数不同,第二种情况是没有达到满流,代表不是所有点都流到目标状态,特判就行了。

/**************************************************************
    Problem: 2668
    User: BLADEVIL
    Language: Pascal
    Result: Accepted
    Time:48 ms
    Memory:6516 kb
****************************************************************/
 
//By BLADEVIL
var
    n, m                        :longint;
    num                         :array[0..30,0..30] of longint;
    source, sink                :longint;
    go                          :array[0..2,0..8] of longint;
    ans                         :longint;
    last                        :array[0..2010] of longint;
    pre, other, len, cost       :array[0..400010] of longint;
    l                           :longint;
    que, d, father              :array[0..2010] of longint;
    flag                        :array[0..2010] of boolean;
    map                         :array[0..30,0..30] of longint;
     
function min(a,b:longint):longint;
begin
    if a>b then min:=b else min:=a;
end;
     
procedure connect(a,b,c,d:longint);
begin
    inc(l);
    pre[l]:=last[a];
    last[a]:=l;
    other[l]:=b;
    len[l]:=c;
    cost[l]:=d;
end;
     
procedure init;
var
    i, j, k                     :longint;
    s                           :char;
    sum1, sum2                  :longint;
    key                         :longint;
    nx, ny                      :longint;
     
begin
    readln(n,m);
    go[1,1]:=-1; go[2,2]:=1; go[1,3]:=1; go[2,4]:=-1;
    go[1,5]:=-1; go[2,5]:=1;
    go[1,6]:=1; go[2,6]:=1;
    go[1,7]:=1; go[2,7]:=-1;
    go[1,8]:=-1; go[2,8]:=-1;
    sum1:=0; sum2:=0; l:=1;
    for i:=1 to n do
        for j:=1 to m do num[i,j]:=(i-1)*m+j;
     
    source:=n*m*3+2; sink:=source+1;
    for i:=1 to n do
    begin
        for j:=1 to m do
        begin
            read(s);
            if s='1' then
            begin
                connect(source,num[i,j]+n*m,1,0);
                connect(num[i,j]+n*m,source,0,0);
                map[i,j]:=1;
                inc(sum1);
            end;
        end;
        readln;
    end;
    for i:=1 to n do
    begin
        for j:=1 to m do
        begin  
            read(s);
            if s='1' then
            begin
                connect(num[i,j]+n*m,sink,1,0);
                connect(sink,num[i,j]+n*m,0,0);
                map[i,j]:=2;
                inc(sum2);
            end;
        end;
        readln;
    end;
    if sum1<>sum2 then
    begin
        writeln(-1);
        halt;
    end;
    for i:=1 to n do
    begin
        for j:=1 to m do
        begin
            read(s);
            key:=ord(s)-48;
            if map[i,j]=0 then
            begin
                connect(num[i,j],num[i,j]+n*m,key div 2,0);
                connect(num[i,j]+n*m,num[i,j],0,0);
                connect(num[i,j]+n*m,num[i,j]+2*n*m,key div 2,0);
                connect(num[i,j]+2*n*m,num[i,j]+n*m,0,0);
            end else
            if map[i,j]=1 then
            begin
                connect(num[i,j],num[i,j]+n*m,key div 2,0);
                connect(num[i,j]+n*m,num[i,j],0,0);
                connect(num[i,j]+n*m,num[i,j]+2*n*m,(key+1) div 2,0);
                connect(num[i,j]+2*n*m,num[i,j]+n*m,0,0);
            end else
            begin
                connect(num[i,j],num[i,j]+n*m,(key+1) div 2,0);
                connect(num[i,j]+n*m,num[i,j],0,0);
                connect(num[i,j]+n*m,num[i,j]+2*n*m,key div 2,0);
                connect(num[i,j]+2*n*m,num[i,j]+n*m,0,0);
            end;
        end;
        readln;
    end;
    for i:=1 to n do
        for j:=1 to m do
            for k:=1 to 8 do
            begin
                nx:=i+go[1,k];
                ny:=j+go[2,k];
                if (nx<1) or (nx>n) or (ny<1) or (ny>m) then continue;
                connect(num[i,j]+2*n*m,num[nx,ny],maxlongint div 10,1);
                connect(num[nx,ny],num[i,j]+2*m*n,0,-1);
            end;
end;
 
function spfa:boolean;
var
    cur, h, t                   :longint;
    q, p                        :longint;
begin
    filldword(d,sizeof(d) div 4, maxlongint div 10);
    d[source]:=0; 
    h:=0; t:=1;
    que[1]:=source;
    while h<>t do
    begin
        h:=h mod 2000+1;
        cur:=que[h];
        flag[cur]:=false;
        q:=last[cur];
        while q<>0 do
        begin
            if len[q]>0 then
            begin
                p:=other[q];
                if d[p]>d[cur]+cost[q] then
                begin
                    d[p]:=d[cur]+cost[q];
                    father[p]:=q;
                    if not flag[p] then
                    begin
                        t:=t mod 2000+1;
                        que[t]:=p;
                        flag[p]:=true;
                    end;
                end;
            end;
            q:=pre[q];
        end;
    end;
    if d[sink]=maxlongint div 10 then exit(false) else exit(true);
end;
 
procedure update;
var
    low, cur                    :longint;
begin
    cur:=sink;
    low:=maxlongint;
    while cur<>source do
    begin
        low:=min(low,len[father[cur]]);
        cur:=other[father[cur] xor 1];
    end;
    cur:=sink;
    while cur<>source do
    begin
        dec(len[father[cur]],low);
        inc(len[father[cur] xor 1],low);
        inc(ans,low*cost[father[cur]]);
        cur:=other[father[cur] xor 1];
    end;
end;
 
procedure main;
var
    q                           :longint;
begin
    while spfa do update;
    q:=last[source];
    while q<>0 do
    begin
        if len[q]>0 then
        begin
            writeln(-1);
            halt;
        end;
        q:=pre[q];
    end;
    writeln(ans);
end;
 
begin
    init;
    main;
end.

 

posted on 2014-01-09 08:18  BLADEVIL  阅读(351)  评论(0编辑  收藏  举报