BAOVE - Bảo vệ

Tác giả: RR

Ngôn ngữ: Pascal

//Wishing myself a happy lunar new year with a lot of accept solutions
//Written by Nguyen Thanh Trung
{$R+,Q+}
PROGRAM BAOVE;
CONST
  fi='';
  fo='';
  maxn=5000;
  max=10000;
  oo=1000000000;
TYPE
  rec=record v:integer; c:longint; end;
  rec2=record u,v:integer; c:longint; end;
VAR
  n:integer;
  queue,cv,trace,degt,degn,th1,th2:array[1..maxn] of integer;
  first,last:integer;
  xet:array[1..maxn] of byte;
  dt:array[1..maxn] of longint;
  et,en:array[1..max] of rec;
  ft:array[1..max] of longint;
  s1,s2:array[1..maxn+1] of integer;
  dscanh:array[1..max] of rec2;
  m:integer;
  f1,f2:text;
  fl:longint;
Procedure OpenFiles;
Begin
  Assign(f1,fi); Reset(f1);
  Assign(f2,fo); Rewrite(f2);
End;
Procedure CloseFiles;
Begin
  Close(f1); Close(f2);
End;
Procedure ReadInput;
Begin
  Readln(f1,n); m:=0;
  While not Eof(f1) do
    begin
      inc(m);
      with dscanh[m] do
        Readln(f1,u,v,c);
    end;
End;
Procedure Trans;
Var
  i:integer;
Begin
  For i:=1 to m do
  with dscanh[i] do
    begin
      inc(degt[u]);
      inc(degn[v]);
    end;
  s1[1]:=1;
  For i:=1 to n do
    s1[i+1]:=s1[i]+degt[i];
  s2[1]:=1;
  For i:=1 to n do
    s2[i+1]:=s2[i]+degn[i];
  For i:=1 to m do
  with dscanh[i] do
    begin
      et[s1[u]+th1[u]].v:=v;
      et[s1[u]+th1[u]].c:=c;
      inc(th1[u]);
      en[s2[v]+th2[v]].v:=u;
      en[s2[v]+th2[v]].c:=s1[u]+th1[u]-1;
      inc(th2[v]);
    end;
End;
Procedure Init;
Begin
  Fillchar(dt,sizeof(dt),0);
  dt[n]:=oo;
  Fillchar(xet,sizeof(xet),0);
  xet[n]:=1;
  first:=1; last:=1;
  queue[first]:=n;
  trace[n]:=0;
End;
Function min(a,b:longint):longint;
Begin
  if a<=b then min:=a else min:=b;
End;
Procedure FindPath;
Var
  u,v,i:integer;
Begin
  while first<=last do
    begin
      u:=queue[first]; inc(first);
      for i:=s1[u] to s1[u+1]-1 do
      with et[i] do
        if (xet[v]=0) and (c-ft[i]>0) then
          begin
            xet[v]:=1;
            inc(last); queue[last]:=v;
            trace[v]:=u; cv[v]:=i;
            dt[v]:=min(dt[u],c-ft[i]);
          end;
      for i:=s2[u] to s2[u+1]-1 do
      with en[i] do
        if (xet[v]=0) and (ft[c]>0) then
          begin
            xet[v]:=1;
            inc(last); queue[last]:=v;
            trace[v]:=-u; cv[v]:=c;
            dt[v]:=min(dt[u],ft[c]);
          end;
      if dt[1]>0 then exit;
    end;
End;
Procedure IncFlow;
Var
  x,pre:integer;
Begin
  x:=1;
  repeat
    pre:=trace[x];
    if pre>0 then ft[cv[x]]:=ft[cv[x]]+dt[1]
    else ft[cv[x]]:=ft[cv[x]]-dt[1];
    x:=abs(pre);
  until x=n;
End;
Procedure Solve;
Begin
  fl:=0;
  repeat
    Init;
    FindPath;
    if dt[1]>0 then IncFlow;
    fl:=fl+dt[1];
  until dt[1]=0;
End;
Procedure WriteOutput;
Begin
  Writeln(f2,fl);
End;
BEGIN
  OpenFiles;
  ReadInput;
  Trans;
  Solve;
  WriteOutput;
  CloseFiles;
END.

Download