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 #219 - Hopcroft-Karp - Fast Matching Algorithm
Ngày: 28-08-2011
Cập nhật: 28-08-2011
Người gửi: yenthanh132
Ngôn ngữ: Pascal
Xem: 606

Điểm: 4.9/5 (15 Phiếu)


Program FMATCH;
Const MaxN=50000;
      MaxC=1000000007;
Type Pnode=^TNode;
     TNode=Record v:Longint; next:Pnode End;
Var a:array[1..MaxN] of Pnode;
    matchX,matchY,dis:array[0..MaxN] of Longint;
    Queue:array[1..MaxN*2] of Longint;
    first,last,n,m,p:Longint;
Procedure Push(u,v:Longint);
Var P:Pnode;
Begin
  New(p);
  p^.v:=v;
  p^.next:=a[u];
  a[u]:=p;
End;
 
Procedure Input;
Var f:text;
    i,u,v:Longint;
Begin
  Assign(f,''); Reset(F);
  Readln(f,n,m,p);
  For i:=1 to p do
    Begin
      Readln(f,u,v);
      Push(u,v);
    End;
  Close(f)
End;
 
Function FindPath:Boolean;
Var u:Longint;
    p:Pnode;
Begin
  First:=1; Last:=0;
  For u:=1 to n do
    If matchX[u]=0 then
      Begin
        dis[u]:=0;
        Inc(last); queue[last]:=u;
      End
    Else dis[u]:=maxC;
  dis[0]:=MaxC;
  While First<=Last do
    Begin
      u:=queue[first]; inc(first);
      p:=a[u];
      While p<>nil do
        Begin
          If dis[matchY[p^.v]]=MaxC then
            Begin
              dis[matchY[p^.v]]:=dis[u]+1;
              If matchY[p^.v]<>0 then
                Begin
                  Inc(Last); queue[last]:=MatchY[p^.v];
                End;
            End;
          p:=p^.next;
        End;
    End;
  Exit(dis[0]<>MaxC);
End;
 
Function DFS(u:Longint):Boolean;
Var p:Pnode;
Begin
  IF u=0 then Exit(True);
  p:=a[u];
  While p<>nil do
    Begin
      If dis[matchY[p^.v]]=dis[u]+1 then
        If DFS(matchY[p^.v]) then
          Begin
            matchX[u]:=p^.v;
            matchY[p^.v]:=u;
            Exit(True);
          End;
      p:=p^.next;
    End;
  Dis[u]:=MaxC;
  Exit(False);
End;
 
Procedure DoMatching;
Var u,res:Longint;
Begin
  res:=0;
  FillChar(matchX,sizeof(MatchX),0);
  FillChar(matchY,sizeof(matchY),0);
  While FindPath do
    For u:=1 to n do
      If matchX[u]=0 then
        If DFS(u) then
          Inc(res);
  Writeln(res);
End;
 
BEGIN
  Input;
  DoMatching;
END.