回溯法第4题—置棋问题

[问题描述]

在m*n的主格中任意指定x个格子构成一个棋盘，在任一个构成的棋盘上放置k个棋子，要求任意两个棋子不得位于同一行或同一列上，要求输出满足条件的所有方案。（注意棋盘是稀疏的，即x<m*n/2。1<m,n<10）。

编程要求：

1．对给定的一个棋盘，求出该棋盘可放置的最多的棋子数p。

2．记di为该棋盘上放置i个棋子时的方案总数（1<i<p）,其中经旋转和镜面反射而得的方案记为不同方案，对每一个i，求出相应的di。

3．程序应能够连续处理多个棋盘，对每一个棋盘，输出p和d1，d2，…，dp，只需输出数字，不必输出具体方案。

输入:第一行是两个数字，代表第一个棋盘的m和n，以下为一个仅由0、1组成的m×n矩阵，某一个位置值为1表示相应的格子在这个棋盘上，为0表示相应的格子不在棋盘上。

输出:第一行是棋盘可放置的最多的棋子数p;

第二行分别列出从1个棋子到放p个棋子的方案总数。

[样例输入]

5 5
0 1 1 1 0
0 1 0 0 0
1 1 1 0 0
0 0 1 0 0
0 0 1 1 0

[输出样例]

the maxnumber=4
1:10
2:28
3:24
4:5

[问题分析]

这道题跟n皇后的题目很像，只不过这道题并没有要求每行每列都必须有棋子，因此为了达到最大放置，有些行或列可以不必放入棋子。

由于x<1/2mn，很稀疏，按照行来搜索肯定效率很低，于是可以把棋盘所有的格子开一个数组记录下来。

下面给出我的代码：

var  chess:array[1..50]of record
                    x,y:integer;
                end;//本数组用来记录棋盘的格子号
      sum,m,n,p:byte;
      line,row:array[1..10]of boolean;//line,row表示某行，某列有无棋子的情况，true表示无，false表示有
      d:array[1..10] of longint;//用来记录放置第i个棋子的方案数，请思考为什么数组上限是10?    procedure init;//初始化
var i,j,int:integer;
begin
  fillchar(row,sizeof(row),true);
  fillchar(line,sizeof(line),true);
  fillchar(d,sizeof(d),0);
  assign(input,‘word.in‘);reset(input);
  assign(output,‘word.out‘);rewrite(output);
  readln(m,n);
  sum:=0;
  for i:=1 to m do
     for j:=1 to n do
       begin
         read(int);
         if  int=1  then
           begin
             inc(sum);
             chess[sum].x:=i;
             chess[sum].y:=j
           end;
       end;
end;
procedure work(next,s:integer);//从第next个可放棋的位置开始寻找第s个棋子可放的一个位置
var i,x,y:integer;
begin
   for i:=next to sum do
     begin
       x:=chess[i].x;y:=chess[i].y;//用x,y变量表示简便
       if line[x] and row[y] then
         begin
           inc(d[s]);line[x]:=false;row[y]:=false;
           work(i+1,s+1);
           line[x]:=true;row[y]:=true;//回溯
         end;
    end;
end;
procedure print;
var i:integer;
begin
  for i:=1 to 10 do if d[i]=0 then break;
  p:=i-1;
  writeln(‘the maxnumber=‘,p);
  for i:=1 to p do
     writeln(1,‘:‘,d[i]);
  close(input);close(output);
end;
begin
  init;
  work(1,1);
  print;
end.

标准程序：

var
   chess:array [1..50] of  record
                              x,y:integer;
                           end;
   row,col:array  [1..10]  of  boolean;
   d:array [1..10]  of  longint;
   m,n,p,sum:byte;
 procedure  init;
 var  i,j,int:integer;
 begin
   sum:=0;
   for i:=1 to m do
     for j:=1 to n do
       begin
         read(int);
         if  int=1  then
           begin
             inc(sum);
             chess[sum].x:=i;
             chess[sum].y:=j
           end;
       end;
       fillchar(row,sizeof(row),true);
       fillchar(col,sizeof(col),true);
       fillchar(d,sizeof(d),0);
 end;
 procedure work(next,s:integer);
 var
  i,x,y:integer;
 begin
   for  i:=next  to  sum  do
     begin
       x:=chess[i].x;y:=chess[i].y;
       if  (row[x])and(col[y])  then
         begin
           inc(d[s]); row[x]:=false;col[y]:=false;
           work(i+1,s+1);
           row[x]:=true;col[y]:=true
         end;
     end;
 end;
 procedure print;
 var i:integer;
 begin
   for  i:=10 downto 1  do
     if  d[i]>0  then break;
   p:=i;
   writeln(‘the maxnumber=‘,p);
   for  i:=1  to  p  do
     writeln(i,‘:‘,d[i])
 end;
 begin
  assign(input,‘word.in‘);reset(input);
  assign(output,‘word.out‘);rewrite(output);
  readln(m,n);
  while (m<>0) and (n<>0) do
    begin
      init;
      work(1,1);
      print;
      readln(m,n);
    end;
 end.

我的和标准程序写的差不多，只看一个就行了。

这道题确实是很简单，但是我却把变量名打反了……然后调了一晚上…………很浪费时间

以后写完程序不要急着去编译，运行，然后出错了再watch……应该先从头到尾仔仔细细的看一遍代码……

这样可以节省很多时间，也可以避免不必要的麻烦……

特别是刷水题的时候尤其要注意这一点……………………

吸取教训………………

回溯法第4题—置棋问题,布布扣,bubuko.com