Online JudgeProblem SetAuthorsOnline ContestsUser
Web Board
Home Page
F.A.Qs
Statistical Charts
Problems
Submit Problem
Online Status
Prob.ID:
Register
Update your info
Authors ranklist
Current Contest
Past Contests
Scheduled Contests
Award Contest
User ID:
Password:
  Register

pascal zkw费用流532ms..打搓了。。

Posted by zhouzixuan at 2014-06-16 22:08:41 on Problem 3680
//Problem:poj 3680;
//Author:zzx;
//Language:Pascal;
//Meno:MaxFlowMinCost;
const
  inf=3208328;
type
  edge=record
    x,f,c,next,op:longint;
  end;
  list=record
    x,y,z:longint;
  end;
var
  point:array [0..2001] of list;
  b:array [0..20000] of edge;
  a,dis,pre,id,cur:array [0..2001] of longint;
  v:array [0..2001] of boolean;
  q:array [0..800000] of longint;
  hash:array [0..2001] of longint;
  cases,casesth,limit,n,tot,sum,m,s,t,ans,cost:longint;
procedure init;
var
  i:longint;
begin
  readln; readln(n,limit); sum:=0; m:=n;
  for i:=1 to n do
  begin
    readln(point[i].x,point[i].y,point[i].z);
    inc(sum); hash[sum]:=point[i].x;
    inc(sum); hash[sum]:=point[i].y;
  end;
end;
procedure qsort(x,y:longint);
var
  p,q,mid:longint;
begin
  p:=x; q:=y; mid:=hash[(x+y) div 2];
  repeat
    while hash[x]<mid do inc(x);
    while hash[y]>mid do dec(y);
    if x<=y then
    begin
      hash[0]:=hash[x]; hash[x]:=hash[y]; hash[y]:=hash[0];
      inc(x); dec(y);
    end;
  until x>y;
  if p<y then qsort(p,y);
  if x<q then qsort(x,q);
end;
procedure cut_repeat;
var
  i:longint;
begin
  sum:=0;
  for i:=1 to 2*n do
  if (sum=0) or (hash[i]<>hash[sum]) then
  begin
    inc(sum); hash[sum]:=hash[i];
  end;
end;
function find(x:longint):longint;
var
  i:longint;
begin
  for i:=1 to sum do if hash[i]=x then exit(i);
end;
procedure addedge(x,y,c,f,t:longint);
begin
  inc(tot);
  b[tot].x:=y;
  b[tot].c:=c;
  b[tot].f:=f;
  b[tot].op:=tot+t;
  b[tot].next:=a[x];
  a[x]:=tot;
end;
procedure buildedge;
var
  i:longint;
begin
  tot:=0; fillchar(a,sizeof(a),0); n:=sum;
  for i:=0 to n do begin addedge(i,i+1,limit,0,1); addedge(i+1,i,0,0,-1); end;
  for i:=1 to m do begin addedge(find(point[i].x),find(point[i].y),1,-point[i].z,1); addedge(find(point[i].y),find(point[i].x),0,point[i].z,-1); end;
  inc(n); s:=0; t:=n;
end;
function min(x,y:longint):longint;
begin
  if x<y then exit(x) else exit(y);
end;
function dfs(x,flow:longint):longint;
var
  now,p,pp,delta:longint;
begin
  if x=t then begin ans:=ans+flow*cost; exit(flow); end;
  p:=cur[x]; p:=a[x]; v[x]:=false; now:=flow;
  while p<>0 do
  begin
    pp:=b[p].x;
    if v[pp]=false then begin p:=b[p].next; continue; end;
    if (b[p].c=0) or (b[p].f<>0) then begin p:=b[p].next; continue; end;
    delta:=dfs(pp,min(flow,b[p].c));
    b[p].c:=b[p].c-delta; b[b[p].op].c:=b[b[p].op].c+delta;
    now:=now-delta; if now=0 then exit(flow); p:=b[p].next;
  end;
  exit(flow-now);
end;
function augment:boolean;
var
  head,tail,k,p,pp,tt,i:longint;
begin
  fillchar(dis,sizeof(dis),$7f);
  head:=1; tail:=1; q[1]:=t; dis[t]:=0;
  repeat
    k:=q[head]; p:=a[k]; inc(head);
    if head>800000 then head:=1;
    while p<>0 do
    begin
      pp:=b[p].x; tt:=dis[k]-b[p].f;
      if (b[b[p].op].c>0) and (tt<dis[pp]) then
      begin
        dis[pp]:=tt;
        if (head=tail+1) then begin inc(tail); if tail>800000 then tail:=1; q[tail]:=pp; end
        else if dis[pp]<=dis[q[head]] then begin dec(head); if head=0 then head:=800000; q[head]:=pp; end
        else if dis[pp]>dis[q[head]] then begin inc(tail); if tail>800000 then tail:=1; q[tail]:=pp; end;
      end;
      p:=b[p].next;
    end;
  until head=tail+1;
  for k:=s to t do
  begin
    p:=a[k];
    while p<>0 do
    begin
      b[p].f:=b[p].f+dis[b[p].x]-dis[k];
      p:=b[p].next;
    end;
  end;
  cost:=cost+dis[s]; exit(dis[s]<inf);
end;
procedure main;
begin
  ans:=0; cost:=0;
  while augment do
  repeat
    fillchar(v,sizeof(v),true);
  until dfs(s,maxlongint)=0;
  writeln(-ans);
end;
begin
  readln(cases);
  for casesth:=1 to cases do
  begin
    init;
    qsort(1,sum);
    cut_repeat;
    buildedge;
    main;
  end;
end.

Followed by:

Post your reply here:
User ID:
Password:
Title:

Content:

Home Page   Go Back  To top


All Rights Reserved 2003-2013 Ying Fuchen,Xu Pengcheng,Xie Di
Any problem, Please Contact Administrator