ENET - Mạng điện

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+}
uses math;
const
  FINP='';
  FOUT='';
  MAXN=2002;
var
  f1,f2:text;
  n,s,t,count,first,last:longint;
  fl,a,c:array[0..MAXN,0..MAXN] of longint;
  deg,luu,ok,xet,queue,trace:array[0..MAXN] of longint;
  path:boolean;
procedure openF;
begin
  assign(f1,FINP); reset(f1);
  assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
  close(f1); close(f2);
end;
procedure inp;
var
  m,u,v,i:longint;
begin
  path:=false;
  read(f1,n,m,s,t);
  for i:=1 to n do
    if (i<>s) and (i<>t) then
      begin
        deg[i]:=1;
        a[i,1]:=i+n;
        c[i,i+n]:=1;
      end
    else
      begin
        deg[i]:=1;
        a[i,1]:=0;
        c[i,0]:=1;
      end;
  for i:=1 to m do
    begin
      read(f1,u,v);
      if ((u=s) and (v=t)) or ((u=t) and (v=s)) then
        begin
          path:=true;
          continue;
        end;
      inc(deg[u+n]); a[u+n,deg[u+n]]:=v; c[u+n,v]:=2;
      inc(deg[v+n]); a[v+n,deg[v+n]]:=u; c[v+n,u]:=2;
    end;
end;
procedure ans;
var
  i:longint;
begin
  if count>0 then
    begin
      ok[s]:=1; ok[t]:=1;
      inc(count,2);
    end;
  if (count=0) and path then
    begin
      ok[s]:=1; ok[t]:=1;
      count:=2;
    end;
  writeln(f2,count);
  for i:=1 to n do
    if ok[i]=1 then writeln(f2,i);
end;
procedure init(u:longint);
begin
  fillchar(xet,sizeof(xet),0); xet[u]:=1;
  fillchar(trace,sizeof(trace),0);
  first:=1; last:=1; queue[1]:=u;
end;
procedure findPath;
var
  u,i,v:longint;
begin
  while first<=last do
    begin
      u:=queue[first]; inc(first);
      for i:=1 to deg[u] do
        begin
          v:=a[u,i];
          if (xet[v]=0) and (c[u,v]>fl[u,v]) then
            begin
              trace[v]:=u;
              xet[v]:=1; inc(last); queue[last]:=v;
            end
          else if (xet[v]=0) and (fl[v,u]>0) then
            begin
              trace[v]:=-u;
              xet[v]:=1; inc(last); queue[last]:=v;
            end;
          if xet[0]=1 then exit;
        end;
    end;
end;
procedure incFlow(start:longint);
var
  v,u:longint;
begin
  u:=0;
  while u<>start do
    begin
      v:=trace[u];
      fl[v,u]:=1;
      u:=v;
    end;
end;
procedure erase(start:longint);
var
  v,u:longint;
begin
  u:=0;
  while u<>start do
    begin
      v:=luu[u];
      fl[v,u]:=0;
      u:=v;
    end;
end;
procedure solve;
var
  i:longint;
begin
  count:=0;
  for i:=1 to n do
  if (i<>s) and (i<>t) then
    begin
      c[i,i+n]:=2;
      init(i); findPath;
      if xet[0]=0 then begin c[i,i+n]:=1; continue; end;
      incFlow(i); luu:=trace;
      init(i);
      findPath;
      if xet[0]=0 then begin c[i,i+n]:=1; erase(i); continue; end;
      erase(i);
      ok[i]:=1; inc(count);
      c[i,i+n]:=1;
    end;
end;
begin
  openF;
  inp;
  solve;
  ans;
  closeF;
end.

Download