PBCWAYS - Trò chơi di chuyển con tốt

Tác giả: RR

Ngôn ngữ: Pascal

{$R+,Q+}
PROGRAM PBCWAYS;
CONST
  fi='';
  fo='';
  max=1001;
VAR
  m,n:integer;
  a,b:array[0..max+1,0..max+1] of integer;
  deg1,deg2,trace:array[0..max+1] of integer;
  xet:array[0..max+1] of integer;
  d:array[0..max+1,0..max+1] of integer;
  fl:integer;
  queue:array[1..max+1] of integer;
  first,last:integer;
Function GetX(i,j:integer):integer;
Begin
  GetX:=(j-1)*2*n+n+i;
End;
Procedure ReadInput;
Var
  f:text;
  i,j,k,i2:integer;
  x1,x2:integer;
Begin
  Assign(f,fi); Reset(f);
  Readln(f,n,m);
  For j:=1 to m-1 do
  For i:=1 to n do
  begin
    X1:=GetX(i,j);
    Read(f,deg1[x1]);
    For k:=1 to deg1[x1] do
    begin
      Read(f,i2);
      x2:=j*2*n+i2;
      a[x1,k]:=x2;
      inc(deg2[x2]);
      b[x2,deg2[x2]]:=x1;
    end;
  end;
  For k:=0 to m-1 do
  For i:=2*k*n+1 to 2*k*n+n do
    begin
      deg1[i]:=1;
      a[i,1]:=i+n;
      inc(deg2[i+n]);
      b[i+n,deg2[i+n]]:=i;
    end;
  deg1[0]:=n;
  For i:=1 to n do
  begin
    a[0,i]:=i;
    inc(deg2[i]);
    b[i,deg2[i]]:=0;
  end;
  deg2[m*2*n+1]:=n;
  For i:=1 to n do
  begin
    x1:=m*2*n-n+i;
    inc(deg1[x1]);
    a[x1,deg1[x1]]:=m*2*n+1;
    b[m*2*n+1,i]:=x1;
  end;
  Close(f);
End;
Procedure WriteOutput;
Var
  f:text;
Begin
  Assign(f,fo); Rewrite(f);
  Writeln(f,fl);
  Close(f);
End;
Procedure Init;
Var
  i:integer;
Begin
  For i:=0 to 2*n*m+1 do trace[i]:=0;
  For i:=0 to 2*n*m+1 do xet[i]:=0;
  first:=1; last:=1;
  queue[1]:=0;
  xet[0]:=1;
End;
Procedure FindPath;
Var
  u,i,v:integer;
Begin
  While first<=last do
    begin
      u:=queue[first]; inc(first);
      For i:=1 to deg1[u] do
        begin
          v:=a[u,i];
          If (xet[v]=0) and (d[u,v]=0) then
            begin
              xet[v]:=1;
              trace[v]:=u;
              inc(last); queue[last]:=v;
            end;
          If xet[2*m*n+1]=1 then exit;
        end;
      For i:=1 to deg2[u] do
        begin
          v:=b[u,i];
          If (xet[v]=0) and (d[v,u]=1) then
            begin
              xet[v]:=1;
              trace[v]:=-u;
              inc(last); queue[last]:=v;
            end;
          If xet[2*m*n+1]=1 then exit;
        end;
    end;
End;
Procedure TangLuong;
Var
  x,pre:integer;
Begin
  x:=2*m*n+1;
  repeat
    pre:=trace[x];
    If pre>=0 then d[pre,x]:=1
    else d[x,-pre]:=0;
    x:=abs(pre);
  until x=0;
  inc(fl);
End;
Procedure Solve;
Begin
  repeat
    Init;
    FindPath;
    If xet[2*m*n+1]=1 then TangLuong;
  until xet[2*m*n+1]=0;
End;
BEGIN
  ReadInput;
  Solve;
  WriteOutput;
END.

Download