二分图集锦

最近状态需要调整的说。。。

题目比较水的描述就不贴了。

1、居然没想到无奇环就是等价于二分图，点数超级小，直接2^n枚举每个点位于那边。

var l,r:array[1..100]of longint;
    n,m,ans:longint;
procedure init;
var i,j,max:longint;
begin
 readln(n,m);
 for i:=1 to m do readln(l[i],r[i]);
 ans:=0;
 for i:=1 to (1<<n)-1 do begin
  max:=m;
  for j:=1 to m do
   if (i >> (l[j]-1) and 1) xor (i >> (r[j]-1) and 1)=0 then dec(max);
  if max>ans then ans:=max
 end;
 writeln(m-ans)
end;
begin
assign(input,'worry.in');reset(input);
assign(output,'worry.out');rewrite(output);
 init;
close(input);close(output)
end.

2、可以看出移动行（i，j）——>（i，j‘），移动列（i，j）——>（i‘，j）

所以，若对角线均为1，每一个行列坐标均不相同，所以只要行列有完备匹配则可行。

var f:array[1..100]of longint;
    b:array[1..100,0..100]of longint;
    c:array[1..100]of boolean;
    ans,n,t:longint;
function edmonds(x:longint):boolean;
var i,ne:longint;
begin
 for i:=1 to b[x,0] do begin
  ne:=b[x,i];
  if c[ne] then begin
   c[ne]:=false;
   if (f[ne]=0)or(edmonds(f[ne])) then begin
    f[ne]:=x;
    exit(true)
   end
  end
 end;
 exit(false)
end;
procedure link(x,y:longint);
begin
 inc(b[x,0]);b[x,b[x,0]]:=y
end;
procedure init;
var i,j,x:longint;
begin
 readln(n);
 fillchar(b,sizeof(b),0);
 for i:=1 to n do begin
  for j:=1 to n do begin
   read(x);
   if x=1 then link(i,j)
  end;
  readln
 end;
 fillchar(f,sizeof(f),0);
 ans:=0;
 for i:=1 to n do begin
  fillchar(c,sizeof(c),true);
  if edmonds(i) then inc(ans)
 end;
 if ans=n then writeln('Y') else writeln('N')
end;
begin
assign(input,'move.in');reset(input);
assign(output,'move.out');rewrite(output);
 readln(t);
 for t:=1 to t do init;
close(input);close(output)
end.

3、重磅级，暴搜+匹配

第四题：牛奶

【题目描述】

       一个被分为n*n个网格的盒子，每一格有可能包含一瓶牛奶或者什么都没有。史密斯先生对每行从左到右记下牛奶的情况，对每列从上到下记下牛奶的情况。每一条记录包含n个数字，0表示没有牛奶，1表示有牛奶。不幸的是，2n条记录的顺序被打乱了，有些数字也模糊不清

       请恢复原来盒子的牛奶情况以及原来记录的顺序

 

【输入数据】

       第一行n表示网格大小

接下来的2n行，每行一条记录，每条记录有n个数字，0表示一定没有牛奶，1表示一定有牛奶，2表示不能确定

 

【输出数据】

       第一行输出n个数，第i个数ai表示第ai条记录对应第i行的信息

第一行输出n个数，第i个数bi表示第bi条记录对应第i列的信息

接下来n行n列输出原来盒子的牛奶情况，0表示没有牛奶，1表示有牛奶

       保证有解，有多组解时输出任意一组即可

 

【输入样例】

5

01210

21120

21001

12110

12101

12101

00011

22222

11001

10010

 

【输出样例】

10 9 8 6 2

4 3 7 5 1

10010

11001

10010

10101

01110

 

【友情提示】

无

 

【数据约定】

30%数据满足n≤5

100%数据满足1≤n≤10

楼教主论文里的题。

一开始天真的想，10！秒过，后来发现是20！的。。。

但是可以发现行确定的话，列之间无约束关系，后面10！实际上是在做匹配，这个实际上是可以用最大匹配实现的。

可是，实际上每搜完行再匹配列比直接搜还要慢。

看了一下mt的标程，每搜完一行，就匹配一次，剪掉大量的支，速度贼快。

于是，踏上了漫长的优化过程。

首先每搜一行，连一次边，匹配一次，超时超到4.5s

改一下搜索从前到后，结果要10.4s（终于理解为什么mt要从后到前，忒不厚道了）

开始边搜边动态连边，匹配。

还是超时了两个点，但是最慢只要1.9s

反思一晚上，每次我不匹配，只对匹配被破坏的点找增广路，顿时快了，只超了一个点，并且最慢的只要1.43s

但是，那一个点怎么都调不出，并且比mt速度慢很多，恐怕只能用mt最喜欢的位运算优化了。。。

先是我的：

{$inline on}
var b:array[1..10,1..10]of longint;
    map:array[1..20,0..20]of boolean;
    b1:array[1..20,0..20]of longint;
    c:array[1..20]of boolean;
    a:array[1..20,1..10]of longint;
    f,g,t,f1:array[0..20]of longint;
    n:longint;
function edmonds(x:longint):boolean;inline;
var i,ne:longint;
begin
 for i:=1 to b1[x,0] do begin
  ne:=b1[x,i];
  if (c[ne]) and (map[x,ne]) and (f[ne]=0) then begin
   c[ne]:=false;
   if (g[ne]=0)or(edmonds(g[ne])) then begin
    g[ne]:=x;t[x]:=ne;
    exit(true)
   end
  end
 end;
 exit(false)
end;
procedure link(x,y:longint);inline;
begin
 inc(b1[x,0]);b1[x,b1[x,0]]:=y
end;
function change(x:longint):boolean;inline;
var i,j,k,ans:longint;
begin
 if x=0 then exit(true);
 for i:=1 to n do if (not(map[i,t[i]]))or(f[t[i]]<>0) then g[t[i]]:=0;
 for i:=1 to n do
 if not(map[i,t[i]])or(f[t[i]]<>0) then begin
  fillchar(c,sizeof(c),true);
  if not edmonds(i) then exit(false);
 end;
 exit(true)
end;
procedure getout;inline;
var i,k,j:longint;
begin
 for i:=1 to n do write(f1[i],' ');writeln;
 for i:=1 to n do write(t[i],' ');writeln;
 for i:=1 to n do
  for k:=1 to n do
   if a[t[i],k]<>2 then b[k,i]:=a[t[i],k];
 for i:=1 to n do begin
  for j:=1 to n do if b[i,j]<>2 then write(b[i,j]) else write(0);
  writeln
 end;
 close(input);close(output);
 halt
end;
procedure dfs(x:longint);inline;
var i,j,k:longint;
    b2:array[1..10]of longint;
    map1:array[1..20,0..20]of boolean;
    g1,t1:array[0..20]of longint;
begin
 if not change(x-1) then exit;
 if x>n then
  getout;
 for i:=n<<1 downto 1 do
  if f[i]=0 then begin
   f[i]:=x;f1[x]:=i;
   b2:=b[x];map1:=map;g1:=g;t1:=t;
   for j:=1 to n do begin
    if a[i,j]<>2 then begin b[x,j]:=a[i,j]; end;
    for k:=1 to b1[j,0] do
     if (a[b1[j,k],x]<>2)and(b[x,j]<>2)and(a[b1[j,k],x]<>b[x,j]) then map[j,b1[j,k]]:=false;
   end;
   dfs(x+1);
   b[x]:=b2;map:=map1;g:=g1;t:=t1;
   f[i]:=0;
  end
end;
procedure init;
var i,j:longint;
    x:char;
begin
 readln(n);
 for i:=1 to n<<1 do begin
  for j:=1 to n  do begin
   read(x);a[i,j]:=ord(x)-48
  end;
  readln
 end;
 fillchar(f,sizeof(f),0);
 fillchar(b1,sizeof(b1),0);
 fillchar(map,sizeof(map),true);
 for i:=1 to n do map[i,0]:=false;
 for i:=1 to n do for j:=1 to n<<1 do link(i,j);
 for i:=1 to n do for j:=1 to n do b[i,j]:=2;f[0]:=1;
 dfs(1)
end;
begin
assign(input,'milk.in');reset(input);
assign(output,'milk.out');rewrite(output);
 init;
close(input);close(output)
end.

再是mt的：

{$inline on}
program mt;
type
  l20 = array[0 .. 20] of longint;
  shortint = longint;
const
  inf = 'milk.in';
  ouf = 'milk.out';
var
  e, f, g, x, p: l20;
  v, u: array[1 .. 20] of boolean;
  a: array[1 .. 20, 1 .. 10] of shortint;
  b: array[1 .. 20, 0 .. 1] of longint;
  i, j, n, n2: longint;
  st: string;

function find(i: longint): boolean; inline;
var
  j: longint;
begin
  for j := 1 to n2 do
    if not v[j] and (e[j] and p[i] > 0) then begin
      v[j] := true;
      if (f[j] = 0) or find(f[j]) then begin
        f[j] := i; g[i] := j; exit(true)
        end;
      end;
  find := false
end;

function change: boolean; inline;
begin
  for i := 1 to n do
    if u[g[i]] or (e[g[i]] and p[i] = 0) then begin
      f[g[i]] := 0; g[i] := 0; v := u;
      if not find(i) then exit(false)
      end;
  change := true
end;

procedure dfs(d: longint); inline;
var
  i: longint; ee, ff, gg: l20;
begin
  if not change then exit;
  if d > n then begin
    for i := 1 to n do write(x[i], ' '); writeln;
    for i := 1 to n do write(g[i], ' '); writeln;
    for i := 1 to n do begin
      for j := 1 to n do
        if a[x[i], j] = 2 then write(a[g[j], i] and 1)
        else write(a[x[i], j] and 1);
      writeln
      end;
    close(input); close(output);
    halt
    end;
  ee := e; ff := f; gg := g;
  for i := n2 downto 1 do
    if not u[i] then begin
      x[d] := i; u[i] := true;
      for j := 1 to n2 do
        if not u[j] and (a[j, d] <> 2) then
          e[j] := e[j] and b[i, a[j, d]];
      dfs(d + 1); e := ee; f := ff; g := gg;
      u[i] := false;
      end;
end;

BEGIN
  assign(input, inf); reset(input);
  assign(output, ouf); rewrite(output);

  readln(n); n2 := n * 2;
  p[1] := 1;
  for i := 2 to n + 1 do p[i] := p[i - 1] shl 1;
  for i := 1 to n2 do begin
    readln(st);
    for j := 1 to n do begin
      a[i, j] := ord(st[j]) - ord('0');
      if a[i, j] <> 0 then b[i, 1] := b[i, 1] or p[j];
      if a[i, j] <> 1 then b[i, 0] := b[i, 0] or p[j];
      end;
    e[i] := p[n + 1] - 1;
    end;
  for i := 1 to n do begin
    f[i] := i; g[i] := i;
    end;
  dfs(1);
END.