Skip to content
Narrow screen resolution Wide screen resolution Auto adjust screen size Increase font size Decrease font size Default font size default color grey color
         
 | 
VNOI - Olympic tin học Việt Nam

Điểm tin VOJ

Số thành viên:6040
Số bài tập:1001
Số bài nộp:722923
Bài nộp hôm nay:0

Top 10 thành viên xuất sắc

HạngThành viênĐiểm
1mr_invincible587.9
2white_cobra418.6
3hieult403.4
4phaleq384.0
5vodanh9x368.2
6con_nha_ngheo352.0
7flash_mt350.2
8darksabers349.8
9yenthanh132345.3
10rockman9x_94343.1
[VOJ] Mã nguồn #213 - PBCWAYS - Sử dụng luồng
Ngày: 02-06-2011
Cập nhật: 02-06-2011
Người gửi: yenthanh132
Ngôn ngữ: Pascal
Xem: 437

Điểm: 4.3/5 (6 Phiếu)


Program PBCWAYS;
Const MaxN=901;
      MaxC=10000000;
Type PNode=^TNode;
     TNode=Record u:Longint; next:PNode End;
Var f,b:array[0..MaxN,0..maxN] of Longint;
    a:array[0..maxN] of PNode;
    Queue:array[1..MaxN+1] of Longint;
    First,Last:Longint;
    Trace,delta:array[0..MaxN] of Longint;
    m,n,nn,res:Longint;
Procedure Push(u,v:Longint);
Var p:PNode;
Begin
  New(p);
  p^.u:=v;
  p^.next:=a[u];
  a[u]:=p;
End;
Procedure Input;
Var f:text;
    i,j,k,c,z:Longint;
Begin
  Assign(f,''); Reset(f);
  Readln(f,n,m);
  FillChar(b,sizeof(b),0);
  For i:=1 to n do
    Begin
      Push(0,i); Push(i,0); b[0,i]:=1;
      Push((m-1)*n+i,m*n+1);
      Push(m*n+1,(m-1)*n+i);
      b[(m-1)*n+i,m*n+1]:=1;
    End;
  For i:=2 to m-1 do
    For j:=1 to n do
      Begin
        Push(j+(i-1)*n,m*n+1+j+(i-2)*n);
        Push(m*n+1+j+(i-2)*n,j+(i-1)*n);
        b[j+(i-1)*n,m*n+1+j+(i-2)*n]:=1;
      End;
  {++++++++++++++++++++++++++++++++++}
  For i:=1 to n do
    Begin
      Read(f,c);
      For j:=1 to c do
        Begin
          Read(f,k);
          Push(i,k+n); Push(k+n,i);
          b[i,k+n]:=1;
        End;
      Readln(f);
    End;
  For i:=2 to m-1 do
    For j:=1 to n do
      Begin
        Read(f,c);
        For z:=1 to c do
          Begin
            Read(f,k);
            Push(m*n+1+j+(i-2)*n,k+i*n);
            Push(k+i*n,m*n+1+j+(i-2)*n);
            b[m*n+1+j+(i-2)*n,k+i*n]:=1;
          End;
      End;
  Close(f);
  nn:=m*n+1+(m-2)*n;
End;
Function Min(a,b:Longint):Longint;
Begin If a<b then exit(a) else exit(b) End;
Function FindPath:Boolean;
Var u,v:Longint;
    p:PNode;
Begin
  First:=1; Last:=1; Queue[1]:=0;
  For u:=1 to nn do trace[u]:=MaxC; trace[0]:=nn+1;
  delta[0]:=MaxC;
  While First<=Last do
    Begin
      u:=Queue[First]; Inc(First); p:=a[u];
      While p<>Nil do Begin
        v:=p^.u;
        If trace[v]=MaxC then
          Begin
            If f[u,v]<b[u,v] then
              Begin
                trace[v]:=u;
                delta[v]:=min(delta[u],b[u,v]-f[u,v]);
              End
            else If f[v,u]>0 then
              Begin
                trace[v]:=-u;
                delta[v]:=min(delta[u],f[v,u]);
              End;
            If trace[v]<>MaxC then
              Begin
                If v=m*n+1 then Exit(True);
                Inc(Last); Queue[Last]:=v;
              End;
          End;
        p:=p^.next;
      End
    End;
  Exit(False)
End;
procedure IncFlow;
Var u,v:Longint;
Begin
  v:=m*n+1;
  Repeat
    u:=trace[v];
    If u>=0 then Inc(f[u,v],delta[m*n+1])
    else
      Begin
        u:=-u;
        Dec(f[v,u],delta[m*n+1]);
      End;
    v:=u;
  Until v=0;
End;
Procedure FindMaxFlow;
Var i:Longint;
Begin
  FillChar(f,sizeof(f),0);
  While FindPath do IncFlow;
  res:=0;
  For i:=1 to n do
    If f[0,i]=1 then Inc(res);
End;
BEGIN
  Input;
  FindMaxFlow;
  If m=1 then writeln(n) else Writeln(res);
END.