BZOJ1443 游戏game （二分图染色+匈牙利算法）

  1 Program Test375num2;
  2 type arr=record
  3         u,v,next:longint;
  4         end;
  5 const dx:array[1..4] of longint=(0,0,-1,1);
  6       dy:array[1..4] of longint=(1,-1,0,0);
  7       maxn=100008;
  8       maxm=maxn*4;
  9 var map:array[0..108,0..108] of longint;
 10     cl:array[0..maxn] of longint;
 11     eg:array[0..maxm] of arr;
 12     last:array[0..maxn] of longint;
 13     l,r,f:array[0..maxn] of longint;
 14     pd:array[0..maxn] of boolean;
 15     i,j,m,n,num,sum,x:longint;
 16     ch:char;
 17 procedure dfs(i,j,w:longint);
 18 var k,x,y:longint;
 19 begin
 20     cl[map[i,j]]:=w;
 21     for k:=1 to 4 do
 22     begin
 23         x:=i+dx[k]; y:=j+dy[k];
 24         if (map[x,y]>0) and (cl[map[x,y]]=0) then
 25             dfs(x,y,3-w);
 26     end;
 27 end;
 28 procedure add(u,v:longint);
 29 begin
 30     inc(sum);
 31     eg[sum].u:=u;
 32     eg[sum].v:=v;
 33     eg[sum].next:=last[u];
 34     last[u]:=sum;
 35 end;
 36 procedure put(i,j:longint);
 37 var k,x,y:longint;
 38 begin
 39     for k:=1 to 4 do
 40     begin
 41         x:=i+dx[k]; y:=j+dy[k];
 42         if (map[x,y]>0) then add(map[i,j],map[x,y]);
 43     end;
 44 end;
 45 function Hungarian(u:longint):boolean;
 46 var i,v:longint;
 47 begin
 48     i:=last[u];
 49     while i<>0 do
 50     begin
 51         v:=eg[i].v;
 52         if not pd[v] then
 53         begin
 54             pd[v]:=true;
 55             if (l[v]=0) or Hungarian(l[v]) then
 56             begin
 57                 r[u]:=v;
 58                 l[v]:=u;
 59                 exit(true);
 60             end;
 61         end;
 62         i:=eg[i].next;
 63     end;
 64     exit(false);
 65 end;
 66 procedure dfsl(u:longint);
 67 var i,v:longint;
 68 begin
 69     f[u]:=2;
 70     i:=last[u];
 71     while i<>0 do
 72     begin
 73         v:=eg[i].v;
 74         if f[v]=0 then
 75         begin
 76             f[v]:=1;
 77             if f[l[v]]=0 then dfsl(l[v]);
 78         end;
 79         i:=eg[i].next;
 80     end;
 81 end;
 82 
 83 procedure dfsr(u:longint);
 84 var i,v:longint;
 85 begin
 86     f[u]:=2;
 87     i:=last[u];
 88     while i<>0 do
 89     begin
 90         v:=eg[i].v;
 91         if f[v]=0 then
 92         begin
 93             f[v]:=1;
 94             if f[r[v]]=0 then dfsr(r[v]);
 95         end;
 96         i:=eg[i].next;
 97     end;
 98 end;
 99 begin
100     readln(m,n);
101     num:=0; sum:=0;
102     for i:=1 to m do
103     begin
104         for j:=1 to n do
105         begin
106             read(ch);
107             if ch=‘.‘ then
108             begin
109                 map[i,j]:=(i-1)*n+j;
110                 inc(num);
111             end
112             else map[i,j]:=-1;
113         end;
114         readln;
115     end;
116     for i:=1 to m do
117         for j:=1 to n do
118             if (map[i,j]>0) and (cl[map[i,j]]=0) then
119                 dfs(i,j,1);
120     for i:=1 to m do
121         for j:=1 to n do
122                         if map[i,j]>0 then put(i,j);
123 
124     fillchar(l,sizeof(l),0);
125     fillchar(r,sizeof(r),0);
126         sum:=0;
127     for i:=1 to m*n do
128         if cl[i]=1 then
129         begin
130             fillchar(pd,sizeof(pd),false);
131              if Hungarian(i) then inc(sum);
132         end;
133     if sum*2=num then
134     begin
135         writeln(‘LOSE‘);
136         halt;
137     end;
138     writeln(‘WIN‘);
139     fillchar(f,sizeof(f),0);
140     for i:=1 to m*n do
141         if (cl[i]>0) and (f[i]=0) and (l[i]=0) and (r[i]=0) then
142             if cl[i]=1 then dfsl(i) else dfsr(i);
143     for i:= 1 to m do
144         for j:=1 to n do
145         begin
146             x:=(i-1)*m+j;
147             if f[x]=2 then writeln(i,‘ ‘,j);
148         end;
149 end.