poj 3740 dancing links

        很早的时候，就听说了dancing links，但是一直觉得多么高深，多么神奇，这几天再回来看的时候，才发现这东西对搜索的优化很无语。

       dancing links发现，在搜索过程中（指精确覆盖），很多行和列被删掉了，可是以后枚举的时候还是会枚举到它，于是，就用链表把删掉的弄走，然后每次就可以少枚举一些东西，剪掉了一些常数，而这个常数的减少对于n！的枚举来说，是非常宝贵，但是，为此，就要用丑丑的双向链表来辅助(!.!写的晕死了)，可能多写一点之后，可以感受到他的mei吧。

 

     ps：代码参考了hyc的，但是缩行实在比不上他，合并了两个过程后，还是比他长些，无语了

    

program poj3740;
var
      r,l,u,d,lin,col,size:array[0..6000]of longint;
      maxn,bj,st,i,j,m,n,x:longint;
      flag:boolean;
procedure inf;
begin
   assign(input,'3740.in');
   assign(output,'3740.out');
   reset(input);rewrite(output);
end;
procedure ouf;
begin
   close(input);close(output);
end;
procedure origin;
begin
    fillchar(l,sizeof(l),0); fillchar(r,sizeof(r),0);
    fillchar(u,sizeof(u),0); fillchar(d,sizeof(d),0);
    fillchar(size,sizeof(size),0);
    fillchar(lin,sizeof(lin),0);
    fillchar(col,sizeof(col),0);
    for i:=1 to m do
      begin
        l[i]:=i-1; r[i]:=i+1; u[i]:=i; d[i]:=i;
      end;
    l[m]:=m-1; r[m]:=0; l[0]:=m;   r[0]:=1;
    for i:=1 to n do
      begin
        l[m+i]:=m+i; r[m+i]:=m+i;
      end;
    st:=n+m;
end;
procedure link(x,y,xx,yy:longint);
begin
    inc(st);
    lin[st]:=x; col[st]:=y;
    l[st]:=l[x]; r[st]:=x; l[r[st]]:=st; r[l[st]]:=st;
    u[st]:=u[y]; d[st]:=y; d[u[st]]:=st; u[d[st]]:=st;
    inc(size[y]);
end;
procedure d_r(x,bj:longint);
var stop,now:longint;
begin
    if bj=1 then begin r[l[x]]:=r[x]; l[r[x]]:=l[x]; end;
    if bj=2 then begin l[r[x]]:=x; r[l[x]]:=x; end;
    stop:=x;
    while d[x]<>stop do
       begin
         x:=d[x];
         now:=x;
         while r[now]<>x do
           begin
              now:=r[now];
              if now<>lin[x] then
                 begin
                   if bj=1 then begin u[d[now]]:=u[now]; d[u[now]]:=d[now]; end;
                   if bj=2 then begin u[d[now]]:=now;    d[u[now]]:=now;    end;
                 end;
           end;
       end;
end;

procedure prepare;
begin
    origin;
     for i:=1 to n do
     begin
      for j:=1 to m do
         begin
            read(x);
            if x=1 then link(i+m,j,i,j);
         end;
      readln;
     end;
end;
procedure dfs(k:longint);
var
    x,now,mov:longint;
begin
    if r[0]=0 then begin flag:=true; exit; end;
    maxn:=-maxlongint;  bj:=0;
    while r[bj]<>0 do
       begin
          bj:=r[bj];
          if size[bj]>maxn then
            begin
              maxn:=size[bj];
              x:=bj;
            end;
       end;
    now:=x; d_r(x,1);
    while d[now]<> x do
      begin
        now:=d[now]; mov:= now;
        while r[mov]<>now do
          begin
            mov:=r[mov];
            if mov<>lin[now] then
            d_r(col[mov],1);
          end;
        dfs(k+1);
        if flag then exit;
        mov:=now;
        while r[mov]<>now do
          begin
            mov:=r[mov];
            if mov<>lin[now] then
              d_r(col[mov],2);
          end;
      end;
    d_r(x,2);
end;

procedure main;
begin
     read(n,m);
     prepare;
     flag:=false;
      dfs(0);
     if flag then writeln('Yes, I found it')
       else writeln('It is impossible');
end;
begin
    inf;
    while not eof do main;
    ouf;
end.