usaco 1.5.4——checker

Checker Challenge 跳棋的挑战

描述

检查一个如下的6 x 6的跳棋棋盘，有六个棋子被放置在棋盘上，使得每行、每列只有一个，每条对角线(包括两条主对角线的所有对角线)上至多有一个棋子。

图见usaco原图

上面的布局可以用序列2 4 6 1 3 5来描述，第i个数字表示在第i行的相应位置有一个棋子，如下：

行号 1 2 3 4 5 6 
列号 2 4 6 1 3 5 

这只是跳棋放置的一个解。请编一个程序找出所有跳棋放置的解。并把它们以上面的序列方法输出。解按字典顺序排列。请输出前3个解。最后一行是解的总个数。

特别注意: 对于更大的N(棋盘大小N x N)你的程序应当改进得更有效。不要事先计算出所有解然后只输出，这是作弊。如果你坚持作弊，那么你登陆USACO Training的帐号将被无警告删除

格式

PROGRAM NAME: checker

INPUT FORMAT:

(checker.in)

一个数字N (6 <= N <= 13) 表示棋盘是N x N大小的。

OUTPUT FORMAT:

(checker.out)

前三行为前三个解，每个解的两个数字之间用一个空格隔开。第四行只有一个数字，表示解的总数。

SAMPLE INPUT

6 

SAMPLE OUTPUT

2 4 6 1 3 5 
3 6 2 5 1 4 
4 1 5 2 6 3 
4

Compiling...
Compile: OK

Executing...
   Test 1: TEST OK [0.000 secs, 276 KB]
   Test 2: TEST OK [0.000 secs, 276 KB]
   Test 3: TEST OK [0.000 secs, 276 KB]
   Test 4: TEST OK [0.000 secs, 276 KB]
   Test 5: TEST OK [0.000 secs, 276 KB]
   Test 6: TEST OK [0.000 secs, 276 KB]
   Test 7: TEST OK [0.054 secs, 276 KB]
   Test 8: TEST OK [0.162 secs, 276 KB]

All tests OK.

Your program ('checker') produced all correct answers! This is your submission #4 for this problem. Congratulations!

 

分析：

额。比较经典的N皇后问题

让我灰常郁闷啊。

开始打的裸dfs，

结果最后一个点超时，

我尝试了好多剪枝和优化，

都不大管用，

在网上看的方法都不大懂，

尤其是那个对称的优化，最让我无语了。。。

于是我采用位运算的方法来计算方案数，

位运算部分完全参考M67牛的文章，

基本没有变化，具体原理说不清。。。

位运算部分参考M67牛的

http://www.matrix67.com/blog/archives/266

{
ID: codeway3
PROG: checker
LANG: PASCAL
}
program checker;
  type
    ll=array[1..15,1..15]of integer;
  var
    i,j,n,bb,m,k,l,js:longint;
    a:ll;
    b:array[1..13]of longint;
  procedure doing(x,y:longint;aa:ll);
    var
      i,j:longint;
    begin
      if m>3 then exit;
      for i:=1 to n do
        begin
          aa[x,i]:=1;
          aa[i,y]:=1;
          if i+y-x in [1..n] then aa[i,i+y-x]:=1;
          if x+y-i in [1..n] then aa[i,x+y-i]:=1;
        end;
      b[x]:=y;
      if x=n then
        begin
          if m<3 then
            begin
              for i:=1 to n-1 do write(b[i],' ');
              writeln(b[n]);
            end;
          inc(m);
          b[x]:=0;
          exit;
        end;
      for i:=1 to n do
        if aa[x+1,i]=0 then doing(x+1,i,aa);
      b[x]:=0;
    end;

  procedure test(row,ld,rd:longint);
    var
      pos,p:longint;
    begin
      if row<>js then
        begin
          pos:=js and not (row or ld or rd);
          while pos<>0 do
            begin
              p:=pos and -pos;
              pos:=pos-p;
              test(row+p,(ld+p)<<1,(rd+p)>>1);
            end;
        end
      else inc(m);
    end;

  begin
    assign(input,'checker.in');
    reset(input);
    assign(output,'checker.out');
    rewrite(output);
    readln(n);
    m:=0;
    for i:=1 to n  do doing(1,i,a);
    m:=0;
    js:=(1<<n)-1;
    test(0,0,0);
    writeln(m);
    close(input);
    close(output);
  end.