比赛 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.