和平委员会 2-sat

按照2-sat的套路直接写就好了...由于要求输出字典序最小的方案数,所以在新图上处理的时候按字典序最小的拓扑序进行染色(不用dfs进行传递)

uses math;
var
        n,m,l,x,y,tt    :longint;
        time,top,size   :longint;
        i               :longint;
        vis             :array[0..160010] of boolean;
        last,la,z       :array[0..160010] of longint;
        pre,other,pr,ot :array[0..40010] of longint;
        belong,dfn,low  :array[0..160010] of longint;
        anti,color,indu :array[0..160010] of longint;
        work,heap       :array[0..160010] of longint;

procedure swap(var a,b:longint);
var
        c:longint;
begin
   c:=a; a:=b; b:=c;
end;

procedure connect(x,y:longint);
begin
   inc(l);
   pre[l]:=last[x];
   last[x]:=l;
   other[l]:=y;
end;
 
procedure connect2(x,y:longint);
begin
   inc(l);
   pr[l]:=la[x];
   la[x]:=l;
   ot[l]:=y;
end;
 
procedure dfs(x:longint);
var
        p,q,cur:longint;
begin
   inc(time);
   low[x]:=time;
   dfn[x]:=time;
   inc(top);
   z[top]:=x;
   vis[x]:=true;
   //
   q:=last[x];
   while q<>0 do
   begin
      p:=other[q];
      if (dfn[p]=0) then
      begin
         dfs(p);
         low[x]:=min(low[x],low[p]);
      end else
      if vis[p] then low[x]:=min(low[x],dfn[p]);
      q:=pre[q];
   end;
   //
   if low[x]=dfn[x] then
   begin
      cur:=-1; inc(tt);
      while cur<>x do
      begin
         cur:=z[top];
         dec(top);
         vis[cur]:=false;
         belong[cur]:=tt;
      end;
   end;
end;

procedure rebuild;
var
        i,p,q:longint;
begin
   l:=0;
   for i:=1 to n<<1 do
   begin
      q:=last[i];
      while q<>0 do
      begin
         p:=other[q];
         if belong[i]<>belong[p] then
         begin
            connect2(belong[p],belong[i]);
            inc(indu[belong[i]]);
         end;
         q:=pre[q];
      end;
   end;
end;

procedure heap_down(i:longint);
var
        t:longint;
begin
   while (i<<1)<=size do
   begin
      if heap[i]heap[(i<<1)+1] then t:=(i<<1)+1;
      if i<>t then
      begin
         swap(heap[i],heap[t]);
         i:=t;
      end else exit;
   end;
end;

procedure heap_up(i:longint);
begin
   if i=1 then exit;
   while i>1 do
   begin
      if heap[i]>1] then
      begin
         swap(heap[i],heap[i>>1]);
         i:=i>>1;
      end else exit;
   end;
end;

procedure insert(x:longint);
begin
   inc(size);
   heap[size]:=x;
   heap_up(size);
end;

procedure topsort_col;
var
        p,q:longint;
begin
   while size<>0 do
   begin
      x:=heap[1];
      heap[1]:=heap[size]; dec(size); heap_down(1);
      if color[x]=0 then
      begin
         color[x]:=1;
         color[anti[x]]:=2;
      end;
      q:=la[x];
      while q<>0 do
      begin
         p:=ot[q];
         dec(indu[p]);
         if indu[p]=0 then insert(p);
         q:=pr[q];
      end;
   end;
end;

begin
   assign(input,'spo.in');reset(input);
   assign(output,'spo.out');rewrite(output);
   read(n,m);
   for i:=1 to m do
   begin
      read(x,y);
      if (y and 1=1) then connect(x,y+1) else connect(x,y-1);
      if (x and 1=1) then connect(y,x+1) else connect(y,x-1);
   end;
   for i:=1 to n<<1 do if dfn[i]=0 then dfs(i);
   for i:=1 to n do
     if (belong[i<<1]=belong[(i<<1)-1]) then
     begin
        writeln('NIE'); close(input); close(output); exit;
     end;
   rebuild;
   for i:=1 to n do
   begin
      anti[belong[i<<1]]:=belong[(i<<1)-1];
      anti[belong[(i<<1)-1]]:=belong[i<<1];
   end;
   for i:=1 to tt do if indu[i]=0 then insert(i);
   topsort_col;
   //
   for i:=1 to n<<1 do
    if color[belong[i]]=1 then writeln(i);
   close(input); close(output);
end.
——by Eirlys

你可能感兴趣的:(bzoj,2-sat)