level 9
__Wa_ff_
楼主
program mlj;{By 孟来俊}
const
MaxN = 1000;
MaxE = 10000;
var
n, e, p, ss, tt, flow : longint;
d, q, edge, prev, shift : array[1..MaxN] of longint;
cont, point, next, back : array[1..MaxE] of longint;
procedure link(u, v, c : longint);{从u到v连一条容量为c的有向边}
begin
inc(e); point[e] := v; cont[e] := c;
next[e] := edge[u]; edge[u] := e;
inc(e); point[e] := u; cont[e] := 0;
next[e] := edge[v]; edge[v] := e;
back[e] := e-1; back[e-1] := e;
end;
procedure improve;{将当前这条增广路进行增广}
var
i, j, delta : longint;
begin
i := prev[tt]; delta := MaxLongint;
while i <> 0 do begin
if cont[shift[i]] <= delta then begin delta := cont[shift[i]]; p := i; end;
i := prev[i];
end;
i := prev[tt];
while i <> 0 do begin
j := shift[i]; dec(cont[j], delta);
j := back[j]; inc(cont[j], delta);
i := prev[i];
end;
flow := flow + delta;
end;
procedure dfs;{用dfs寻找当前这层网络的增广路}
var
exist : boolean;
i, j, k : longint;
begin
for i := 1 to n do shift[i] := edge[i];
i := ss; prev[ss] := 0;
while i <> 0 do begin
j := shift[i]; exist := false;
while j <> 0 do begin
k := point[j];
if (cont[j] > 0) and (d[i] + 1 = d[k]) then begin
shift[i] := j; prev[k] := i; i := k; exist := true;
if i = tt then begin improve; i := p; end;
break;
end;
j := next[j];
end;
if not(exist) then begin d[i] := -1; i := prev[i]; end;
end;
end;
function bfs : boolean;{用bfs对网络进行分层}
var
h, t, i, j, k : longint;
begin
for i := 1 to n do d[i] := -1;
h := 0; t := 1; q[1] := ss; d[ss] := 0;
repeat
inc(h); i := q[h]; j := edge[i];
while j <> 0 do begin
k := point[j];
if (cont[j] > 0) and (d[k] = -1) then begin
inc(t); q[t] := k; d[k] := d[i] + 1;
if k = tt then exit(true);
end;
j := next[j];
end;
until h = t;
bfs := false;
end;
procedure Dinic;
begin
flow := 0; while bfs do dfs;
end;
begin
Dinic;
end.
2012年05月11日 14点05分
1
const
MaxN = 1000;
MaxE = 10000;
var
n, e, p, ss, tt, flow : longint;
d, q, edge, prev, shift : array[1..MaxN] of longint;
cont, point, next, back : array[1..MaxE] of longint;
procedure link(u, v, c : longint);{从u到v连一条容量为c的有向边}
begin
inc(e); point[e] := v; cont[e] := c;
next[e] := edge[u]; edge[u] := e;
inc(e); point[e] := u; cont[e] := 0;
next[e] := edge[v]; edge[v] := e;
back[e] := e-1; back[e-1] := e;
end;
procedure improve;{将当前这条增广路进行增广}
var
i, j, delta : longint;
begin
i := prev[tt]; delta := MaxLongint;
while i <> 0 do begin
if cont[shift[i]] <= delta then begin delta := cont[shift[i]]; p := i; end;
i := prev[i];
end;
i := prev[tt];
while i <> 0 do begin
j := shift[i]; dec(cont[j], delta);
j := back[j]; inc(cont[j], delta);
i := prev[i];
end;
flow := flow + delta;
end;
procedure dfs;{用dfs寻找当前这层网络的增广路}
var
exist : boolean;
i, j, k : longint;
begin
for i := 1 to n do shift[i] := edge[i];
i := ss; prev[ss] := 0;
while i <> 0 do begin
j := shift[i]; exist := false;
while j <> 0 do begin
k := point[j];
if (cont[j] > 0) and (d[i] + 1 = d[k]) then begin
shift[i] := j; prev[k] := i; i := k; exist := true;
if i = tt then begin improve; i := p; end;
break;
end;
j := next[j];
end;
if not(exist) then begin d[i] := -1; i := prev[i]; end;
end;
end;
function bfs : boolean;{用bfs对网络进行分层}
var
h, t, i, j, k : longint;
begin
for i := 1 to n do d[i] := -1;
h := 0; t := 1; q[1] := ss; d[ss] := 0;
repeat
inc(h); i := q[h]; j := edge[i];
while j <> 0 do begin
k := point[j];
if (cont[j] > 0) and (d[k] = -1) then begin
inc(t); q[t] := k; d[k] := d[i] + 1;
if k = tt then exit(true);
end;
j := next[j];
end;
until h = t;
bfs := false;
end;
procedure Dinic;
begin
flow := 0; while bfs do dfs;
end;
begin
Dinic;
end.