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.