比赛 |
20120708 |
评测结果 |
AWTTTTTTTT |
题目名称 |
最小最大生成树 |
最终得分 |
10 |
用户昵称 |
IMSL77 |
运行时间 |
8.006 s |
代码语言 |
Pascal |
内存使用 |
12.60 MiB |
提交时间 |
2012-07-08 11:55:50 |
显示代码纯文本
program mstmn;
type
integer=longint;
edges=record st,en,w:integer; end;
const
maxn=21000;
maxm=210000;
INF=10000000;
var
n,m:integer;
s,t,tot,L:integer;
edge:array[1..maxm] of edges;
ver,current:array[1..maxn] of integer;
en,next:array[1..maxm shl 1] of integer;
Cap,Flow:array[1..maxm shl 1] of integer;
ver2:array[1..maxn] of integer;
en2,next2:array[1..maxm shl 1] of integer;
mark:array[1..maxn] of boolean;
level:array[1..maxn] of integer;
Q:array[1..maxn] of integer;
procedure Fopen;
begin
assign(input,'mstmn.in'); reset(input);
assign(output,'mstmn.out'); rewrite(output);
end;
procedure Fclose;
begin
close(input); close(output);
end;
procedure Init;
var
i:integer;
begin
readln(n,m);
for i:=1 to m do readln(edge[i].st,edge[i].en,edge[i].w);
readln(s,t,L);
end;
procedure QSort(l,r:integer);
var
i,j:integer;
x:integer; t:edges;
begin
i:=l; j:=r;
x:=edge[(l+r) shr 1].w;
repeat
while edge[i].w<x do inc(i);
while edge[j].w>x do dec(j);
if i<=j then
begin
t:=edge[i]; edge[i]:=edge[j]; edge[j]:=t;
inc(i); dec(j);
end;
until i>j;
if l<j then QSort(l,j);
if i<r then QSort(i,r);
end;
procedure addedge(u,v,c:integer);
begin
inc(tot);
en[tot]:=v; next[tot]:=ver[u]; ver[u]:=tot;
Cap[tot]:=c;
end;
procedure SetGraph(u:integer);
var
k,v:integer;
begin
mark[u]:=false;
k:=ver2[u];
while k>0 do
begin
v:=en2[k];
if mark[v] then
begin
addedge(u,v,1); addedge(v,u,0);
SetGraph(v);
end;
k:=next2[k];
end;
end;
function BFS:boolean;
var
head,tail:integer;
k,x,y:integer;
begin
fillchar(level,sizeof(level),0);
level[s]:=1;
head:=1; tail:=2;
Q[1]:=s;
repeat
x:=Q[head];
k:=ver[x];
while k>0 do
begin
y:=en[k];
if (Cap[k]>Flow[k]) and (level[y]=0) then
begin
level[y]:=level[x]+1;
if y=t then exit(true);
Q[tail]:=y;
inc(tail);
end;
k:=next[k];
end;
inc(head);
until head=tail;
exit(level[t]>0);
end;
function min(a,b:integer):integer;
begin
if a<b then exit(a) else exit(b);
end;
function DFS(u,cur:integer):integer;
var
f,delta:integer;
k,v:integer;
begin
if u=t then exit(cur);
f:=cur;
k:=current[u];
while k>0 do
begin
v:=en[k];
if (Cap[k]>Flow[k]) and (level[u]+1=level[v]) then
begin
delta:=DFS(v,min(f,Cap[k]-Flow[k]));
inc(Flow[k],delta);
dec(Flow[k xor 1],delta);
dec(f,delta);
if f=0 then break;
end;
k:=next[k];
end;
current[u]:=k;
exit(cur-f);
end;
function Dinic:integer;
var
maxflow,delta:integer;
begin
fillchar(Flow,sizeof(Flow),0);
maxflow:=0;
while BFS do
repeat
current:=ver;
delta:=DFS(s,INF);
inc(maxflow,delta);
until delta=0;
exit(maxflow);
end;
procedure Solve;
var
i:integer;
ans:integer;
begin
QSort(1,m);
ans:=0;
fillchar(ver2,sizeof(ver2),0);
fillchar(next2,sizeof(next2),0);
tot:=0;
for i:=1 to m do if edge[i].w<L then
begin
inc(tot);
en2[tot]:=edge[i].en; next2[tot]:=ver2[edge[i].st]; ver2[edge[i].st]:=tot;
inc(tot);
en2[tot]:=edge[i].st; next2[tot]:=ver2[edge[i].en]; ver2[edge[i].en]:=tot;
end else break;
tot:=1;
fillchar(mark,sizeof(mark),true);
SetGraph(s);
ans:=ans+Dinic;
fillchar(ver2,sizeof(ver2),0);
fillchar(next2,sizeof(next2),0);
tot:=0;
for i:=m downto 1 do if edge[i].w>L then
begin
inc(tot);
en2[tot]:=edge[i].en; next2[tot]:=ver2[edge[i].st]; ver2[edge[i].st]:=tot;
inc(tot);
en2[tot]:=edge[i].st; next2[tot]:=ver2[edge[i].en]; ver2[edge[i].en]:=tot;
end else break;
tot:=1;
fillchar(mark,sizeof(mark),true);
SetGraph(s);
ans:=ans+Dinic;
writeln(ans);
end;
begin
Fopen;
Init;
Solve;
Fclose;
end.