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.