NOI2009植物大战僵尸

  1 type node=record
  2       go,next,c:longint;
  3       end;
  4 var e:array[0..500000] of node;
  5     head,tail,i,n,m,j,tot,max,ans,s,t,x,y:longint;
  6     w,cur,first,inp,q,h:array[0..1000] of longint;
  7     can:array[0..1000] of boolean;
  8     a:array[0..1000,0..1000] of longint;
  9 procedure insert(x,y,z:longint);
 10  begin
 11  inc(tot);
 12  e[tot].go:=y;
 13  e[tot].c:=z;
 14  e[tot].next:=first[x];
 15  first[x]:=tot;
 16  inc(tot);
 17  e[tot].go:=x;
 18  e[tot].c:=0;
 19  e[tot].next:=first[y];
 20  first[y]:=tot;
 21  end;
 22 function min(x,y:longint):longint;
 23  begin
 24    if x<y then exit(x) else exit(y);
 25  end;
 26 procedure init;
 27  begin
 28    readln(n,m);
 29    fillchar(inp,sizeof(inp),0);
 30    for i:=1 to n*m do
 31     begin
 32       read(w[i]);read(a[i,0]);
 33       for j:=1 to a[i,0] do
 34        begin
 35          read(x,y);inc(x);inc(y);
 36          a[i,j]:=(x-1)*m+y;
 37          inc(inp[(x-1)*m+y]);
 38        end;
 39       if i mod m<>1 then
 40         begin
 41           inc(a[i,0]);a[i,a[i,0]]:=i-1;inc(inp[i-1]);
 42         end;
 43       readln;
 44     end;
 45  end;
 46 procedure topsort;
 47  begin
 48    head:=0;tail:=0;
 49    fillchar(q,sizeof(q),0);
 50    fillchar(can,sizeof(can),false);
 51    for i:=1 to n*m do
 52     if inp[i]=0 then
 53      begin
 54        can[i]:=true;inc(tail);q[tail]:=i;
 55      end;
 56    while head<tail do
 57     begin
 58       inc(head);
 59       x:=q[head];
 60       for i:=1 to a[x,0] do
 61        begin
 62          y:=a[x,i];
 63          dec(inp[y]);
 64          if inp[y]=0 then
 65            begin
 66              can[y]:=true;
 67              inc(tail);
 68              q[tail]:=y;
 69            end;
 70        end;
 71     end;
 72  end;
 73 procedure makegraph;
 74  begin
 75    max:=0;
 76    for i:=1 to n*m do
 77     if can[i] then
 78       begin
 79         if w[i]>0 then inc(max,w[i]);
 80         for j:=1 to a[i,0] do
 81          begin
 82            y:=a[i,j];
 83          if can[y] then insert(y,i,maxlongint>>2);
 84          end;
 85         if w[i]>0 then insert(s,i,w[i])
 86         else insert(i,t,-w[i]);
 87       end;
 88  end;
 89 function bfs:boolean;
 90  var i,x,y:longint;
 91  begin
 92    fillchar(h,sizeof(h),0);
 93    fillchar(q,sizeof(q),0);
 94    head:=0;tail:=1;q[1]:=s;h[s]:=1;
 95    while head<tail do
 96     begin
 97      inc(head);
 98      x:=q[head];
 99      i:=first[x];
100      while i<>0 do
101       begin
102        y:=e[i].go;
103        if (h[y]=0) and (e[i].c<>0) then
104         begin
105          h[y]:=h[x]+1;
106          inc(tail);
107          q[tail]:=y;
108         end;
109        i:=e[i].next;
110       end;
111     end;
112   exit(h[t]<>0);
113  end;
114 function dfs(x,f:longint):longint;
115  var i,y,tmp,used:longint;
116  begin
117    if (x=t) or (f=0) then exit(f);
118    i:=cur[x];tmp:=0;used:=0;
119    while i<>0 do
120     begin
121      y:=e[i].go;
122      if (h[y]=h[x]+1) and (e[i].c<>0) then
123        begin
124         tmp:=dfs(y,min(e[i].c,f-used));
125         dec(e[i].c,tmp);
126         inc(e[i xor 1].c,tmp);
127         if e[i].c<>0 then cur[x]:=i;
128         inc(used,tmp);
129         if used=f then exit(f);
130        end;
131      i:=e[i].next;
132     end;
133    if used=0 then h[x]:=-1;
134    exit(used);
135  end;
136 
137 procedure dinic;
138  begin
139    while bfs do
140     begin
141      for i:=0 to n*m+1 do cur[i]:=first[i];
142      inc(ans,dfs(s,maxlongint>>2));
143     end;
144  end;
145 
146 procedure main;
147  begin
148    tot:=1;
149    s:=0;t:=n*m+1;
150    topsort;
151    makegraph;
152    dinic;
153    writeln(max-ans);
154  end;
155 begin
156   init;
157   main;
158 end.
159