@2004年集训队论文
一种简易的方法求解流量有上下界的网络中网络流问题
的问题1.1
一开始建图建反了T T
论文里很详细..不多说了=w=
code:
var
tmp,ans,tot,n,m,i,j,s,t,x,y,z,z1,z2,min,lo,p,flow:longint;
su,path,dis,anti,next,his,pre,di,vh,a,b,c,flo:array[0..100009] of longint;
flag:boolean;
begin
tot:=0;ans:=0;tmp:=0;
fillchar(su,sizeof(su),0);
fillchar(b,sizeof(b),0);
read(n,m);
for i:=1 to m do
begin
read(x,y,z1,z2);
flo[i]:=z1;
su[x]:=su[x]-z1;
su[y]:=su[y]+z1;
tot:=tot+1;a[tot]:=y;c[tot]:=z2-z1;next[tot]:=b[x];b[x]:=tot;anti[tot]:=tot+1;
tot:=tot+1;a[tot]:=x;c[tot]:=0;next[tot]:=b[y];b[y]:=tot;anti[tot]:=tot-1;
end;
s:=n+1;t:=n+2;
for i:=1 to n do
if su[i]>0 then
begin
tot:=tot+1;a[tot]:=i;c[tot]:=su[i];next[tot]:=b[s];b[s]:=tot;anti[tot]:=tot+1;
tot:=tot+1;a[tot]:=s;c[tot]:=0;next[tot]:=b[i];b[i]:=tot;anti[tot]:=tot-1;
tmp:=tmp+su[i];
end
else
begin
tot:=tot+1;a[tot]:=t;c[tot]:=-su[i];next[tot]:=b[i];b[i]:=tot;anti[tot]:=tot+1;
tot:=tot+1;a[tot]:=i;c[tot]:=0;next[tot]:=b[t];b[t]:=tot;anti[tot]:=tot-1;
end;
for i:=1 to n+2 do
di[i]:=b[i];
vh[0]:=n+2;
fillchar(dis,sizeof(dis),0);
s:=n+1;t:=n+2;
i:=s;flow:=maxlongint;
while dis[s]<=(n+1) do
begin
flag:=false;his[i]:=flow;p:=di[i];
while p<>0 do
begin
j:=a[p];z:=c[p];
if ((dis[j]+1)=dis[i]) and (z>0) then
begin
if z<flow then flow:=z;
path[j]:=p;pre[j]:=i;
di[i]:=p;flag:=true;i:=j;
if i=t then
begin
ans:=ans+flow;
while i<>s do
begin
p:=path[i];c[p]:=c[p]-flow;
c[anti[p]]:=c[anti[p]]+flow;
i:=pre[i];
end;
flow:=maxlongint;
end;
break;
end;
p:=next[p];
end;
if flag then continue;
min:=t;p:=b[i];
while p<>0 do
begin
j:=a[p];
if (dis[j]<min) and (c[p]>0) then
begin
min:=dis[j];lo:=p;
end;
p:=next[p];
end;
di[i]:=lo;
vh[dis[i]]:=vh[dis[i]]-1;
if vh[dis[i]]=0 then break;
dis[i]:=min+1;inc(vh[min+1]);
if i<>s then begin i:=pre[i];flow:=his[i];end;
end;
if ans<tmp then writeln('NO') else begin writeln('YES');
for i:=1 to m do
begin
flo[i]:=flo[i]+c[i*2];
writeln(flo[i]);
end;end;
end.