匿名使用者2022.03.16 回答

var

k：integer；

a：array［1。。20］of integer； //按順序存20個數

function pd1（i，j：integer）：boolean； //判斷（pd）j在1到i-1有沒有出現

begin

pd1：=true；

for k：=1 to i-1 do

if a［k］=j then

begin

pd1：=false；

exit；

end；

end；

function pd2（x：integer）：boolean；//判斷x是否為質數

begin

pd2：=true；

for k：=2 to trunc（sqrt（x）） do

if x mod k=0 then

begin

pd2：=false；

exit；

end；

end；

function pd3（i，j：integer）：boolean；//判斷i後面能不能接j

begin

pd3：=true；

if i<20 then pd3：=pd2（a［i-1］+j）

else

if （pd2（a［i-1］+j）） and （pd2（j+1））//最後一個元素有兩個條件

then pd3：=true

else pd3：=false；

end；

procedure try（i：integer）；//深搜

var

j：integer；

begin

for j：=2 to 20 do

begin

if （pd1（i，j）） and （pd3（i，j））//條件滿足

then

begin

a［i］：=j；

if i=20//深搜結束條件

then

begin

for j：=1 to 20 do

write（a［j］，‘ ’）；//輸出

writeln

halt；

end；

try（i+1）；//深搜下一層

a［i］：=0；//回溯，實際上沒必要賦值

end；

end；

end；

begin

for k：=1 to 20 do

a［k］：=0；//初始化

a［1］：=1；//由對稱性不失一般性，以1為第一個元素

try（2）；//從第二個元素開始深搜

end。

匿名使用者2020.04.30 回答

b：=［2，3，5，7，11，13，17，19，23，29，31］；

意識很好，

你在定義過程中錯了

Procedure

exchange（a，b）；

y：=a；

a：=b；

b：=y；

end；

For

i：=1

to

n-1

do

c：=1；d：=2；

While

（true）

do

If

a［i］+a［i+1］<>b

then

begin

exchange（a［i+c］，a［i+d］）；d：=d+1；

else

break；

{這不是排序，但需要一個一個交換比較加起來是否為素數，沒有遺漏}

我只把主程式寫了出來，其他小部分自己填充

遙遠的海2016.12.04 回答

這是一個搜尋問題，層數為20，在深搜可以接受的範圍之內

思路是，先確定第一個元素為1

然後依次往後推，每個元素都要滿足和前一個的和為素數

關於這個你可以先做一個初始化

f［i，j］ofboolean

表示i後面能不能接j（這個在下面那個程式裡沒有最佳化）

最後一個元素還要滿足和1的和為素數

下面這個程式不是我寫的，可能寫得比較醜，但是時間上是沒問題的

（但註釋是原創）

var

k：integer；

a：array［1。。20］ofinteger；//按順序存20個數

functionpd1（i，j：integer）：boolean；//判斷（pd）j在1到i-1有沒有出現

begin

pd1：=true；

fork：=1toi-1do

ifa［k］=jthen

begin

pd1：=false；

exit；

end；

end；

functionpd2（x：integer）：boolean；//判斷x是否為質數

begin

pd2：=true；

fork：=2totrunc（sqrt（x））do

ifxmodk=0then

begin

pd2：=false；

exit；

end；

end；

functionpd3（i，j：integer）：boolean；//判斷i後面能不能接j

begin

pd3：=true；

ifi<20thenpd3：=pd2（a［i-1］+j）

else

if（pd2（a［i-1］+j））and（pd2（j+1））//最後一個元素有兩個條件

thenpd3：=true

elsepd3：=false；

end；

proceduretry（i：integer）；//深搜

var

j：integer；

begin

forj：=2to20do

begin

if（pd1（i，j））and（pd3（i，j））//條件滿足

then

begin

a［i］：=j；

ifi=20//深搜結束條件

then

begin

forj：=1to20do

write（a［j］，‘’）；//輸出

writeln

halt；

end；

try（i+1）；//深搜下一層

a［i］：=0；//回溯，實際上沒必要賦值

end；

end；

end；

begin

fork：=1to20do

a［k］：=0；//初始化

a［1］：=1；//由對稱性不失一般性，以1為第一個元素

try（2）；//從第二個元素開始深搜

end。

//夠詳細了吧~

二是＊我的個性2016.12.04 回答

var

k：integer；

a：array［1。。20］of integer； //按順序存20個數

function pd1（i，j：integer）：boolean； //判斷（pd）j在1到i-1有沒有出現

begin

pd1：=true；

for k：=1 to i-1 do

if a［k］=j then

begin

pd1：=false；

exit；

end；

end；

function pd2（x：integer）：boolean；//判斷x是否為質數

begin

pd2：=true；

for k：=2 to trunc（sqrt（x）） do

if x mod k=0 then

begin

pd2：=false；

exit；

end；

end；

function pd3（i，j：integer）：boolean；//判斷i後面能不能接j

begin

pd3：=true；

if i<20 then pd3：=pd2（a［i-1］+j）

else

if （pd2（a［i-1］+j）） and （pd2（j+1））//最後一個元素有兩個條件

then pd3：=true

else pd3：=false；

end；

procedure try（i：integer）；//深搜

var

j：integer；

begin

for j：=2 to 20 do

begin

if （pd1（i，j）） and （pd3（i，j））//條件滿足

then

begin

a［i］：=j；

if i=20//深搜結束條件

then

begin

for j：=1 to 20 do

write（a［j］，‘ ’）；//輸出

writeln

halt；

end；

try（i+1）；//深搜下一層

a［i］：=0；//回溯，實際上沒必要賦值

end；

end；

end；

begin

for k：=1 to 20 do

a［k］：=0；//初始化

a［1］：=1；//由對稱性不失一般性，以1為第一個元素

try（2）；//從第二個元素開始深搜

end。