求Pascal高手指點八皇后問題

2022-06-12 12:55:11 字數 5708 閱讀 2971

1樓:

太複雜了。

program hh;

const n=8;

var i,j,k:integer;

x:array[1..n] of integer;

function place(k:integer):boolean;

var i:integer;

begin

place:=true;

for i:=1 to k-1 do

if (x[i]=x[k]) or (abs(x[i]-x[k])=abs(i-k)) then

place:=false ;

end;

procedure print;

var i:integer;

begin

for i:=1 to n do write(x[i]:4);

writeln;

end;

begin

k:=1;x[k]:=0;

while k>0 do

begin

x[k]:=x[k]+1;

while (x[k]<=n) and (not place(k)) do x[k]:=x[k]+1;

if x[k]>n then k:=k-1else if k=n then printelse begin k:=k+1;x[k]:=0 endend ;

end.

n皇后問題

2樓:匿名使用者

好複雜啊.....

n皇后沒這麼複雜的,一個過程就可以搞定,開3個陣列判重

8皇后問題pascal

3樓:問題要被解決

八皇后是經典的回溯問題,先放**:

program ex1;

vara:array[1..100]of integer;

b,c,d:array[-100..100]of boolean;

n,i,j,k:integer;

procedure try(k:integer);

var i:integer;

begin

if k>n then begin for j:=1 to n do write(a[j],' ');writeln;end

else begin

for i:=1 to n do

if (b[i])and(c[k+i])and(d[k-i])then begin a[k]:=i;

b[i]:=false;

c[k+i]:=false;

d[k-i]:=false;

try(k+1);

b[i]:=true;

c[k+i]:=true;

d[k-i]:=true;

end;

end;

end;

begin

readln(n);

fillchar(b,sizeof(b),true);

fillchar(c,sizeof(c),true);

fillchar(d,sizeof(d),true);

try(1);

readln;

end.

重點是判斷橫豎斜,祝你成功!

急求pascal版回溯法解八皇后問題

4樓:匿名使用者

在一個8×8的棋盤裡放置8個皇后,要求每個皇后兩兩之間不相"衝"(在每一橫列豎列斜列只有一個皇后)。

〖問題分析〗(聿懷中學呂思博)

這道題可以用遞迴迴圈來做,分別一一測試每一種擺法,直到得出正確的答案。主要解決以下幾個問題:

1、衝突。包括行、列、兩條對角線:

(1)列:規定每一列放一個皇后,不會造成列上的衝突;

(2)行:當第i行被某個皇后佔領後,則同一行上的所有空格都不能再放皇后,要把以i為下標的標記置為被佔領狀態;

(3)對角線:對角線有兩個方向。在同一對角線上的所有點(設下標為(i,j)),要麼(i+j)是常數,要麼(i-j)是常數。

因此,當第i個皇后佔領了第j列後,要同時把以(i+j)、(i-j)為下標的標記置為被佔領狀態。

2、資料結構。

(1)解陣列a。a[i]表示第i個皇后放置的列;範圍:1..8

(2)行衝突標記陣列b。b[i]=0表示第i行空閒;b[i]=1表示第i行被佔領;範圍:1..8

(3)對角線衝突標記陣列c、d。

c[i-j]=0表示第(i-j)條對角線空閒;c[i-j]=1表示第(i-j)條對角線被佔領;範圍:-7..7

d[i+j]=0表示第(i+j)條對角線空閒;d[i+j]=1表示第(i+j)條對角線被佔領;範圍:2..16

〖演算法流程〗

1、資料初始化。

2、從n列開始擺放第n個皇后(因為這樣便可以符合每一豎列一個皇后的要求),先測試當前位置(n,m)是否等於0(未被佔領):

如果是,擺放第n個皇后,並宣佈佔領(記得要橫列豎列斜列一起來哦),接著進行遞迴;

如果不是,測試下一個位置(n,m+1),但是如果當n<=8,m=8時,卻發現此時已經無法擺放時,便要進行回溯。

3、當n>;8時,便一一列印出結果。

〖優點〗逐一測試標準答案,不會有漏網之魚。

〖參考程式〗queen.pas

programtt;

vara:array[1..8]ofinteger;

b,c,d:array[-7..16]ofinteger;

t,i,j,k:integer;

procedureprint;

begin

t:=t+1;

write(t,'');

fork:=1to8dowrite(a[k],'');

writeln;

end;

proceduretry(i:integer);

varj:integer;

begin

forj:=1to8do

if(b[j]=0)and(c[i+j]=0)and(d[i-j]=0)then

begin

a:=j;

b[j]:=1;

c[i+j]:=1;

d[i-j]:=1;

ifi<8thentry(i+1)

elseprint;

b[j]:=0;

c[i+j]:=0;

d[i-j]:=0;

end;

end;

begin

fork:=-7to16do

begin

b[k]:=0;

c[k]:=0;

d[k]:=0;

end;

try(1);

end.

****************************************==

這是n皇后問題,看看吧:

在n*n的棋盤上,放置n個皇后,要求每一橫行每一列,每一對角線上均只能放置一個皇后,問可能的方案及方案數。

const max=8;

var i,j:integer;

a:array[1..max] of 0..max; //放皇后陣列

b:array[2..2*max] of boolean; // 『/』對角線標誌陣列}

c:array[-(max-1)..max-1] of boolean;// 『\』對角線標誌陣列}

col:array[1..max] of boolean; //列標誌陣列}

total:integer; //統計總數}

procedure output; //這裡是輸出過程

var i:integer;

begin

write('no.':4,'[',total+1:2,']');

for i:=1 to max do write(a[i]:3);write(' ');

if (total+1) mod 2 =0 then writeln; inc(total);

end;

function ok(i,dep:integer):boolean; //判斷第dep行第i列可放否?

begin

ok:=false;

if ( b[i+dep]=true) and ( c[dep-i]=true) and

(col[i]=true) then ok:=true

end;

procedure try(dep:integer);

var i,j:integer;

begin

for i:=1 to max do //每一行均有max种放法,對吧?xixi~~~~

if ok(i,dep) then begin

a[dep]:=i;

b[i+dep]:=false; // 『/』對角線已放標誌

c[dep-i]:=false; // 『\』對角線已放標誌

col[i]:=false; // 列已放標誌

if dep=max then output

else try(dep+1); // 遞迴下一層

a[dep]:=0; //取走皇后,回溯

b[i+dep]:=true; //恢復標誌陣列

c[dep-i]:=true;

col[i]:=true;

end;

end;

begin

for i:=1 to max do begin a[i]:=0;col[i]:=true;end;

for i:=2 to 2*max do b[i]:=true;

for i:=-(max-1) to max-1 do c[i]:=true;

total:=0;

try(1);

writeln('total:',total);

end.

5樓:冰

我自己編的,僅供參考

program dd;

vari,he:longint;

a,b:array[1..8] of boolean;

c,d:array[-7..16] of boolean;

procedure cou(h,o:longint; var y:longint);

varl:longint;

begin

for l:=1 to 8 do

if a[h] and b[l] and c[h+l] and d[h-l] then begin

a[h]:=false;

b[l]:=false;

c[h+l]:=false;

d[h-l]:=false;

if h>=8 then y:=y+1

else cou(h+1,l,y);

a[h]:=true;

b[l]:=true;

c[h+l]:=true;

d[h-l]:=true;

end;

end;

begin

for i:=1 to 8 do

begin

a[i]:=true;

b[i]:=true;

end;

for i:=-7 to 16 do

begin

c[i]:=true;

d[i]:=true;

end;

he:=0;

cou(1,1,he);

writeln(he);

end.

求高手指點

你可以這樣來試 去了老記憶體,直接用單一的新記憶體看是不是會有問題存在 如果還有問題則可能是這記憶體有直接問題或是與其他的硬體不相容影起。一般可以相應在coms中調整記憶體引數來進行 相應把記憶體速度往低的方向調 如果單一用新記憶體沒問題而兩根一起用會出問題的話就明顯是兩根記憶體不相容問題了。這種情...

求翻譯,求高手指點

實際上鐵道機車車輛極不舒服。如果是作為一項忍耐力測試,比起雨中或者汙濁的空氣裡在長途汽車外坐四個小時,那麼相比之下鐵路還稍微舒服一點。實際上坐火車並不舒服。如果這是一項要在車廂外的雨天或者汙濁的空氣中坐上四個小時的忍耐力測試,火車是不能給予人更多的舒適感受的。實際rolling stock是極不舒服...

求wow高手指點

用t6幾件來評價裝備不太合理 74命中偏低,作為 戰士保證技能的全命中就好了需要8 的命中理論128命中,不用盲目堆命中,90左右就夠用多彩用混亂之天火鑽石,多彩的 狂暴戰士用雙持重傷天賦,不出泰坦之握,用兩把單手 兩把先兆不爽 斧專天賦爆擊堆到40 或以上吧 1600偏低 聽說過布胖4000 戰士...