poj 3648 Wedding 2_SAT

题目大意

  有n对夫妇第i对夫妇表示为i-1h、i-1w。每对夫妇必须坐在桌子的不同侧。现在有m对通奸关系，新娘（0号妻子）不想看到她对面的任意两个人有通奸关系。求一种满足的坐法并输出坐新娘同侧的人。

 

分析

  因为每对夫妻要么夫左妻右要么夫右妻左，所以很明显是一道2-SAT问题。

  建图：设i'为第i个人的伴侣。对于某对通奸关系i和j，则连边i->j',j->i'。最后从新娘连一条边指向新郎以至于必须选新郎。

  话说输出方案真的好麻烦，期望以后在比赛中不要遇到这样的题。

  其实麻烦的地方是建图，所有的2—SAT都这样。

  有多组数据，记得要重置数组。

 

代码

type
arr=record
x,y,next:longint;
end;

var
a,a1:array[1..200000] of arr;
f:array[1..400] of boolean;
ls,zan,g,con,b,c,co:array[1..400] of longint;
dfn,low:array[1..400] of longint;
x,y,z:array[1..400] of longint;
tot,sum,n,m:longint;
i,j,k:longint;
e,d:longint;
cc:char;
s:string;

procedure add(x,y:longint);
begin
inc(e);
a[e].x:=x;
a[e].y:=y;
a[e].next:=ls[x];
ls[x]:=e;
end;

function min(x,y:longint):longint;
begin
if x<y then exit(x)
else exit(y);
end;

procedure dfs(x:longint);
var
i:longint;
begin
inc(d);
dfn[x]:=d;
low[x]:=d;
inc(tot);
zan[tot]:=x;
f[x]:=true;
i:=ls[x];
while i>0 do
with a[i] do
begin
if dfn[y]=0
then begin
dfs(y);
low[x]:=min(low[x],low[y]);
end
else if f[y] then low[x]:=min(low[x],dfn[y]);
i:=next;
end;
if low[x]=dfn[x] then
begin
inc(sum);
repeat
i:=zan[tot];
dec(tot);
f[i]:=false;
g[i]:=sum;
until i=x;
end;
end;

procedure tarjan;
var
i:longint;
begin
fillchar(f,sizeof(f),0);
fillchar(low,sizeof(low),0);
fillchar(dfn,sizeof(dfn),0);
fillchar(g,sizeof(g),0);
tot:=0;
sum:=0;
d:=0;
for i:=1 to n*2 do
if dfn[i]=0
then
dfs(i);
end;

procedure topsort;
var
i,j,k:longint;
head,tail:longint;
begin
head:=0;
tail:=0;
fillchar(b,sizeof(b),0);
for i:=1 to sum do
if c[i]=0 then
begin
tail:=tail+1;
b[tail]:=i;
end;
if tail=0 then exit;
repeat
head:=head+1;
i:=ls[b[head]];
while i<>0 do
with a[i] do
begin
c[y]:=c[y]-1;
if c[y]=0
then
begin
tail:=tail+1;
b[tail]:=y;
end;
i:=next;
end;
until tail=head;
end;

procedure set_b(r:longint);
var
i,j,k:longint;
begin
i:=ls[r];
co[r]:=-1;
while i>0 do
with a[i] do
begin
if co[y]=0
then set_b(y);
i:=next;
end;
end;

procedure set_r;
var
i,j,k:longint;
begin
for i:=1 to sum do
if co[b[i]]=0
then
begin
co[b[i]]:=1;
set_b(con[b[i]]);
end;
end;

procedure print;
var
i,t1,t2:longint;
begin
for i:=2 to n do
begin
if i>2 then write(' ');
if co[g[i]]=-1
then
write(i-1,'h')
else
write(i-1,'w');
end;
writeln;
end;

procedure work;
var
i,j,k:longint;
begin
fillchar(con,sizeof(con),0);
for i:=1 to n do
begin
if g[i]=g[i+n] then
begin
writeln('bad luck');
exit;
end;
con[g[i]]:=g[i+n];
con[g[i+n]]:=g[i];
end;
fillchar(ls,sizeof(ls),0);
fillchar(c,sizeof(c),0);
for i:=1 to e do
with a[i] do
if g[x]<>g[y] then
begin
add(g[y],g[x]);
c[g[x]]:=c[g[x]]+1;
end;
topsort;
fillchar(co,sizeof(co),0);
set_r;
print;
end;

function ban(x:longint):longint;
begin
if x>n then exit(x-n);
exit(x+n);
end;

procedure init;
var
i,j,k:longint;
begin
fillchar(ls,sizeof(ls),0);
for i:=1 to m do
begin
read(cc);
s:='';
while cc in ['0'..'9'] do
begin
s:=s+cc;
read(cc);
end;
val(s,j);
j:=j+1;
if cc='w' then j:=j+n;
read(cc);
read(cc);
s:='';
while cc in ['0'..'9'] do
begin
s:=s+cc;
read(cc);
end;
val(s,k);
k:=k+1;
if cc='w' then k:=k+n;
add(j,ban(k));
add(k,ban(j));
readln;
end;
add(1+n,1);
end;

begin
readln(n,m);
while n+m>0 do begin
e:=0;
init;
tarjan;
work;
readln(n,m);
end;
end.