[求助]n皇后 — 编程爱好者社区

主题：[求助]n皇后

贺天行宝 [专家分：2300] 发布于 2006-03-21 20:41:00

n到13我的算法就来不及了，谁帮帮我！
var
  s:array[1..14]of integer;
  a,b,c:array[-14..28]of boolean;
  i,j,k,l,m,n,sum:integer;
procedure serch(m:integer);
var
  i:integer;
begin
  if m=n+1 then begin inc(sum);
                      if sum<=3 then begin write(s[1]);for i:=2 to n do write(' ',s[i]);
                      writeln; end;
                      exit;
                end;
  for i:=1 to n do
    if (a[i])and(b[m-i])and(c[m+i]) then begin
                                           a[i]:=false;b[m-i]:=false;c[m+i]:=false;
                                           s[m]:=i;
                                           serch(m+1);
                                           a[i]:=true;b[m-i]:=true;c[m+i]:=true;
                                         end;
end;
begin
  assign(input,'checker.in');reset(input);
  assign(output,'checker.out');rewrite(output);
  readln(n);sum:=0;
  for i:=-14 to 28 do
    begin a[i]:=true;b[i]:=true;c[i]:=true; end;
  serch(1);
  writeln(sum);
  close(input);close(output);
end.

本帖地址： http://bbs.pfan.cn/post/149620.html

回复列表（共4个回复）

沙发

贺天行宝 [专家分：2300] 发布于 2006-03-23 20:33:00

帮忙啊！

板凳

封天怒龙 [专家分：160] 发布于 2006-03-29 13:19:00

var a:array [1..9] of 1..9;
    n,t:word;
procedure print;
var
  j:byte;
begin
  t:=t+1;
  write('No. ',t,' ');
  for j:=1 to n do
   write('(',j,',',a[j],') ');
   writeln;
  if t mod 24=0 then readln;
end;
function check(s,i:byte):boolean;
var
  j:byte;
begin
  check:=false;
  for j:=1 to s-1 do
    if (i=a[j]) or (abs(s-j)=abs(i-a[j])) then exit;
  check:=true;
end;
procedure sub(s:byte);
var
  i:byte;
begin
  if s>n then
    print
   else
    for i:=1 to n do
      if check(s,i) then
       begin
        a[s]:=i;
        sub(s+1);
       end;
end;
begin
  repeat
   write('Queen Number: ');
   readln(n);
  until n in [4..9];
  t:=0;
  sub(1);
  readln;
end.

3 楼

贺天行宝 [专家分：2300] 发布于 2006-03-29 19:54:00

你
这还要曼阿
for j:=1 to s-1 do
if (i=a[j]) or (abs(s-j)=abs(i-a[j])) then exit;
是什么意思啊？？

4 楼

linhan828 [专家分：280] 发布于 2006-04-01 17:07:00

program queen;
var
stack:array[1..20] of byte;
n,total:longint;
procedure make(l:integer);
var
  i,j:integer;
  att:boolean;
begin
  if l=n+1 then
   inc(total);
  for i:=1 to n do
   begin
    att:=false;
    stack[l]:=i;
    for j:=1 to (l-1) do
     if (abs(l-j)=abs(stack[j]-i)) or (i=stack[j]) then
      begin
       att:=true;
       j:=l-1;
      end;
     if not att then make(l+1);
     end;
    end;
   begin
    total:=0;
    fillchar(stack,sizeof(stack),0);
    write('n=');
    readln(n);
    make(1);
    writeln('total=':9,total);
   end.

我来回复

您尚未登录，请登录后再回复。点此登录或注册

主题：[求助]n皇后

回复列表（共4个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

主题：[求助]n皇后

回复列表 （共4个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

回复列表（共4个回复）