讨论 / 前面有人发过这种方法了了……我发个pascal的好了
神之水灵 2013-07-08 02:18:00
点我顶贴 收藏 删除
program destroy;

const inf=maxlongint shr 1;

type alice=record

x,y,f,next,op:longint;

end;

var tot,n,m,s,t,i,head,tail,sum,ii,iii:longint;

first,tfirst:array[1..1000]of longint;

bian:array[1..100000]of alice;

level,xx,yy,ff,q,u,r:array[1..10000]of longint;

v:array[1..1000]of boolean;

g:array[1..1000,1..1000]of boolean;

procedure connect(x,y,f:Longint);

begin

inc(tot);

bian[tot].x:=x;

bian[tot].y:=y;

bian[tot].f:=f;

bian[tot].op:=tot+1;

bian[tot].next:=first[x];

first[x]:=tot;

inc(tot);

bian[tot].x:=y;

bian[tot].y:=x;

bian[tot].f:=f;

bian[tot].op:=tot-1;

bian[tot].next:=first[y];

first[y]:=tot;

end;

function bfs:boolean;

var j,k,x,y:longint;

begin

for j:=1 to n do

begin

level[j]:=inf;

v[j]:=false;

tfirst[j]:=first[j];

end;

head:=0;

tail:=1;

q[1]:=s;

level[s]:=0;

v[s]:=true;

repeat

inc(head);

x:=q[head];

k:=first[x];

while k<>0 do

begin

y:=bian[k].y;

if bian[k].f>0 then

if level[y]>level[x]+1 then

begin

level[y]:=level[x]+1;

if not v[y] then

begin

inc(tail);

q[tail]:=y;

v[y]:=true;

if y=t then exit(true);

end;

end;

k:=bian[k].next;

end;

v[x]:=false;

until head=tail;

exit(false);

end;

function min(a,b:longint):longint;

begin

if a<b then exit(a)

else exit(b);

end;

function dfs(x,ff:longint):longint;

var y,j,k,tf,tmp:longint;

begin

if x=t then exit(ff);

tf:=0;

k:=tfirst[x];

while k<>0 do

begin

tfirst[x]:=k;

y:=bian[k].y;

if bian[k].f>0 then

if level[y]=level[x]+1 then

begin

tmp:=dfs(y,min(ff,bian[k].f));

if tmp>0 then

begin

dec(bian[k].f,tmp);

inc(tf,tmp);

inc(bian[bian[k].op].f,tmp);

dec(ff,tmp);

end;

end;

k:=bian[k].next;

end;

exit(tf);

end;

procedure main;

var tmp:longint;

begin

while bfs do

begin

tmp:=dfs(s,inf);

while tmp>0 do tmp:=dfs(s,inf);

end;

end;

begin

readln(n,m,s,t);

for i:=1 to m do

begin

readln(xx[i],yy[i],ff[i]);

connect(xx[i],yy[i],ff[i]);

u[i]:=tot-1;

end;

main;//找最大流

fillchar(g,sizeof(g),false);

for i:=1 to n do

begin

ii:=first[i];

while ii<>0 do

begin

if bian[ii].f>0 then g[i,bian[ii].y]:=true;

ii:=bian[ii].next;

end;

end;

for i:=1 to n do //传递闭包

for ii:=1 to n do

for iii:=1 to n do

g[i,ii]:=g[i,ii] or(g[i,iii] and g[iii,ii]);

sum:=0;

for i:=1 to m do

if (not g[xx[i],yy[i]])or(not g[yy[i],xx[i]]) then

begin

inc(sum);

r[sum]:=i;

end;

writeln(sum);

for i:=1 to sum do writeln(r[i]);

end.

dinic后用残量网络传递闭包

(学的时间不长,很多术语都不懂,所以没写多少注释……大家将就着看程序吧)

查看更多回复
提交回复