bzoj 1565 最大权闭合子图

因为每个植物都有保护的点(每排相邻的右面的算是保护左面的)，所以连他和保护

的点一条边，然后每个点有自己的权值，要找到最大的权值且满足每个点在访问时他

的前驱一定被访问，那么反向建边，转化为后继必须访问，即求一个

最大权闭合子图，然后转化为网络流最小割模型求解。。
然后因为成环的点肯定不会被毁掉，所以直接删了，可以由拓扑排序得出，可以提高速度

然后我还是tle了。。。有个480A的码，明儿看看啥意思吧。。。

/**************************************************************

    Problem: 1565

    User: BLADEVIL

    Language: Pascal

    Result: Time_Limit_Exceed

****************************************************************/

 

//By BLADEVIL

var

    n, m                        :longint;

    num                         :array[0..40,0..40] of longint;

    key                         :array[0..40,0..40] of longint;

    sum                         :array[0..2000] of longint;

    flag                        :array[0..2000] of boolean;

    que                         :array[0..2000] of longint;

    other, len, pre, succ       :array[0..2000000] of longint;

    l                           :longint;

    last                        :array[0..2000] of longint;

    source, sink                :longint;

    ans                         :longint;

    d                           :array[0..2000] of 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];

    succ[pre[l]]:=l;

    last[x]:=l;

    other[l]:=y;

    len[l]:=z;

end;

     

     

procedure topo_sort;

var

    h, t, q, p                  :longint;

    i                           :longint;

    cur                         :longint;

     

begin

    h:=0; t:=1;

    for i:=1 to num[n-1,m-1] do

        if sum[i]=0 then

        begin

            inc(t);

            que[t]:=i;

        end;

    while h<t do

    begin

        inc(h);

        cur:=que[h];

        q:=last[cur];

        flag[cur]:=true;

        while q<>0 do

        begin

            p:=other[q];

            if len[q]=0 then

            begin

                dec(sum[p]);

                if sum[p]=0 then

                begin

                    inc(t);

                    que[t]:=p;

                end;

            end;

            q:=pre[q];

        end;

    end;

end;

     

procedure init;

var

    i, j, k                     :longint;

    x, y, cur                   :longint;

    q, p                        :longint;

     

begin

    read(n,m);l:=1;

    for i:=0 to n-1 do

        for j:=0 to m-1 do

            num[i,j]:=i*m+j+1;

    for i:=0 to n-1 do

        for j:=0 to m-1 do

        begin

            read(key[i,j]);

            read(cur);

            for k:=1 to cur do

            begin

                read(x,y);

                connect(num[i,j],num[x,y],0);

                inc(sum[num[x,y]]);

                connect(num[x,y],num[i,j],maxlongint);

            end;

        end;

    for i:=0 to n-1 do

        for j:=1 to m-1 do

        begin

            connect(num[i,j],num[i,j-1],0);

            inc(sum[num[i,j-1]]);

            connect(num[i,j-1],num[i,j],maxlongint);

        end;

    topo_sort;

    for i:=1 to num[n-1,m-1] do

        if not flag[i] then

        begin

            q:=last[i];

            while q<>0 do

            begin

                p:=q xor 1;

                if succ[p]<>0 then pre[succ[p]]:=pre[p];

                succ[pre[p]]:=succ[p];

                q:=pre[q];

            end;

        end;

end;

 

function bfs:boolean;

var

    q, p                        :longint;

    h, t                        :longint;

    cur                         :longint;

     

begin

    fillchar(d,sizeof(d),0);

    h:=0; t:=1;

    d[source]:=1;

    que[1]:=source;

    while h<t do

    begin

        inc(h);

        cur:=que[h];

        q:=last[cur];

        while q<>0 do

        begin

            p:=other[q];

            if (flag[p]) and (len[q]>0) and (d[p]=0) then

            begin

                inc(t);

                que[t]:=p;

                d[p]:=d[cur]+1; 

                if p=sink then exit(true);

            end;

            q:=pre[q];

        end;

    end;

    exit(false);

end;

 

function dinic(x,flow:longint):longint;

var

    q, p                        :longint;

    tmp, rest                   :longint;

begin

    if x=sink then exit(flow);

    rest:=flow;

    q:=last[x];

    while q<>0 do

    begin

        p:=other[q];

        if (len[q]>0) and (flag[p]) and (d[x]+1=d[p]) 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;

var

    i, j                        :longint;

begin

    source:=num[n-1,m-1]+2; sink:=source+1;

    for i:=0 to n-1 do

        for j:=0 to m-1 do

        if flag[num[i,j]] then

            if key[i,j]>0 then

            begin

                inc(ans,key[i,j]);

                connect(source,num[i,j],key[i,j]);

                connect(num[i,j],source,0);

            end else

            begin

                connect(num[i,j],sink,-key[i,j]);

                connect(sink,num[i,j],0);

            end;

    flag[sink]:=true; flag[source]:=true;

    while bfs do ans:=ans-dinic(source,maxlongint);

    if ans>0 then writeln(ans) else writeln(0);

end;

 

begin

    init;

    main;

end.