|
|
数独の解を求めるプログラム試作しました
空白枡における置数可能数字を、
順次仮置し再帰的に総当り探索して、
解を求めるものです
初期盤面データは、data文で与えます
通常の数独問題の解の個数は１個ですが、
複数解がある場合も、全ての解を求めます
lark12_long
' 数独求解ax.bas
' ９×９数独をプログラムで解く
' 再帰的総当り法
'
' 複数個の解が有る場合は、全てを解く
'
' マウス左クリックで１時停止、右クリックで終了
'
gx=1000
gy=1000
'描画エリアの背景色着色範囲設定
set area color 1 '黒
plot area : -gx,-gy;-gx,gy;gx,gy;gx,-gy
set window 0,900,0,900
'----------------------------------------------------------------
'初期データ
'DATA 0,0,4, 0,0,0, 0,5,0
'DATA 0,0,8, 0,0,0, 2,0,9
'DATA 0,0,3, 0,0,4, 0,0,0
'DATA 0,0,0, 0,2,0, 3,8,0
'DATA 0,0,0, 5,0,7, 0,0,0
'DATA 0,4,6, 0,3,0, 0,0,0
'DATA 0,0,0, 2,0,0, 4,0,0
'DATA 3,0,7, 0,0,0, 9,0,0
'DATA 0,9,0, 0,0,0, 5,0,0
'data 0,1,0,0,0,9,0,0,4
'data 7,6,0,0,0,0,9,1,0
'data 0,0,3,2,0,8,0,6,0
'data 0,0,1,0,5,0,2,0,7
'data 0,0,0,9,0,1,0,0,0
'data 4,0,8,0,3,0,6,0,0
'data 0,8,0,3,0,6,5,0,0
'data 0,7,6,0,0,0,0,8,2
'data 2,0,0,4,0,0,0,3,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'data 0,0,7,8,0,4,3,0,0
'data 0,0,0,7,0,2,0,0,0
'data 6,0,0,0,9,0,0,0,4
'data 5,7,0,0,0,0,0,4,9
'data 0,0,9,0,0,0,1,0,0
'data 3,1,0,0,0,0,0,5,2
'data 7,0,0,0,2,0,0,0,5
'data 0,0,0,4,0,7,0,0,0
'data 0,0,2,3,0,5,4,0,0
'H20-06-28(土)、朝日新聞
'data 1,0,0,0,0,0,0,6,0
'data 0,9,0,0,6,7,0,0,3
'data 0,0,8,0,9,0,0,0,0
'data 0,0,0,1,0,0,0,9,0
'data 0,6,3,0,0,0,5,2,0
'data 0,4,0,0,0,5,0,0,0
'data 0,0,0,0,3,0,7,0,0
'data 2,0,0,7,8,0,0,1,0
'data 0,8,0,0,0,0,0,0,4
'H20-07-05(土)、朝日新聞 47秒
'data 0,2,7,0,0,0,0,0,0
'data 5,0,0,7,0,0,4,0,0
'data 9,0,0,0,0,3,2,8,0
'data 0,4,0,0,0,0,9,0,0
'data 0,0,0,0,2,0,0,0,0
'data 0,0,6,0,0,0,0,1,0
'data 0,6,1,3,0,0,0,0,8
'data 0,0,9,0,0,4,0,0,6
'data 0,0,0,0,0,0,5,2,0
'H20-07-12、朝日新聞
'data 3,5,6,0,0,2,0,1,0
'data 8,0,0,0,6,3,0,0,9
'data 1,0,0,5,7,0,0,0,0
'data 0,0,9,8,0,0,0,3,5
'data 0,3,8,0,0,0,6,7,0
'data 6,4,0,0,0,7,9,0,0
'data 0,0,0,0,8,5,0,0,1
'data 4,0,0,9,3,0,0,0,6
'data 0,1,0,6,0,0,5,9,8
'H20-07-19,朝日新聞
'data 8,0,0,0,0,0,0,3,0
'data 0,7,0,0,9,0,0,2,1
'data 0,0,4,6,0,0,0,0,0
'data 0,0,5,0,4,0,0,0,0
'data 0,8,0,3,0,2,0,5,0
'data 0,0,0,0,7,0,8,0,0
'data 0,0,0,0,0,6,5,0,0
'data 5,3,0,0,2,0,0,1,0
'data 0,1,0,0,0,0,0,0,6
'H20-07-26,朝日新聞
'data 0,0,0,2,0,0,0,0,1
'data 5,0,0,3,0,8,2,0,6
'data 0,1,0,0,0,7,4,0,0
'data 0,3,0,0,6,0,0,0,0
'data 4,0,5,0,0,0,8,0,2
'data 0,0,0,0,5,0,0,1,0
'data 0,0,1,6,0,0,0,7,0
'data 2,0,7,4,0,9,0,0,5
'data 3,0,0,0,0,5,0,0,0
'H20-08-02,朝日新聞
'data 0,6,0,0,0,1,0,0,0
'data 4,0,1,0,3,0,0,9,0
'data 0,3,0,5,0,0,8,0,0
'data 0,0,9,0,0,0,0,4,0
'data 1,0,0,0,6,0,0,0,2
'data 0,8,0,0,0,0,9,0,0
'data 0,0,8,0,0,4,0,1,0
'data 0,7,0,0,9,0,2,0,6
'data 0,0,0,7,0,0,0,3,0
'2008-8-23難易度５
'data 0,0,0,5,0,0,2,3,0
'data 9,0,0,0,8,0,0,0,0
'data 0,0,6,0,0,0,0,0,7
'data 0,4,0,7,0,0,0,0,0
'data 0,0,3,0,0,0,0,0,0
'data 2,7,0,0,0,9,0,1,0
'data 1,0,0,0,0,0,8,0,0
'data 3,0,0,0,5,0,0,0,0
'data 0,9,7,0,0,6,0,0,0
'2010-9-18朝日新聞
'data 0,0,0,4,0,1,0,2,0
'data 0,1,0,0,7,0,0,0,6
'data 0,0,5,0,0,0,8,0,0
'data 6,0,0,1,0,0,0,9,0
'data 0,0,9,0,2,0,6,0,0
'data 0,2,0,0,0,8,0,0,3
'data 0,0,7,0,0,0,3,0,0
'data 8,0,0,0,5,0,0,0,0
'data 0,0,0,0,0,0,0,0,0
'世界一難しいナンクロ(1)
'data 0,0,5,3,0,0,0,0,0
'data 8,0,0,0,0,0,0,2,0
'data 0,7,0,0,1,0,5,0,0
'data 4,0,0,0,0,5,3,0,0
'data 0,1,0,0,7,0,0,0,6
'data 0,0,3,2,0,0,0,8,0
'data 0,6,0,5,0,0,0,0,9
'data 0,0,4,0,0,0,0,3,0
'data 0,0,0,0,0,9,7,0,0
'世界一難しいナンクロ(2)
'data 0,2,6,0,0,1,0,0,0
'data 0,0,0,0,0,0,0,0,3
'data 0,0,0,0,4,3,0,0,5
'data 9,0,1,0,0,0,0,0,0
'data 0,0,7,0,0,0,6,0,0
'data 0,0,0,0,0,0,8,0,4
'data 4,0,0,9,2,0,0,0,0
'data 5,0,0,0,0,0,0,0,0
'data 0,0,0,8,0,0,7,1,0
'朝日H22-10-23
'data 0,9,0,0,1,0,0,6,0
'data 4,0,1,0,0,9,3,0,0
'data 0,0,0,0,6,0,0,5,0
'data 0,0,6,0,4,0,1,0,0
'data 3,0,0,8,0,5,0,0,9
'data 0,0,5,0,2,0,7,0,0
'data 0,3,0,0,9,0,0,0,0
'data 0,0,4,1,0,0,8,0,6
'data 0,8,0,0,5,0,0,3,0
'例題２ 複数解あり
'data 2,8,4,0,0,0,0,7,9
'data 1,0,0,0,4,8,5,0,6
'data 0,9,0,0,0,2,0,0,1
'data 0,4,8,0,0,0,0,0,0
'data 0,2,0,0,0,0,0,3,0
'data 0,0,0,0,0,0,1,0,0
'data 0,0,0,3,0,0,0,9,0
'data 0,0,7,6,8,0,0,0,4
'data 0,5,0,0,0,0,6,1,3
'H26-09-18 複数解あり
data 1,0,0,0,0,0,0,0,0
data 0,6,0,2,0,0,0,0,0
data 0,0,0,0,0,0,3,0,0
data 0,4,0,0,0,0,0,0,0
data 0,0,0,0,5,0,0,0,0
data 0,0,0,0,0,0,0,6,0
data 0,0,7,0,0,0,0,0,0
data 0,0,0,0,0,8,0,0,0
data 0,0,0,0,0,0,0,0,9
'---------------------------------------------------------------------
dim m(0 to 8,0 to 8) 'ﾎﾞｰﾄﾞ領域
dim q(0 to 8,0 to 8,0 to 8) '置数可能数字ｴﾘﾔ
mat read m '問題を読み込む
dim flag(0 to 8,0 to 8) '既置数済みｻｲﾝ
'初期設定済升目ｻｲﾝｾｯﾄ
for p=0 to 80
row=int(p/9) '行と列に換算する
col=mod(p,9)
if m(row,col)<>0 then
flag(row,col)=1
end if
next p
'置数可能な数字の設定
'初期空白ﾏｽに、置数可能数１～９を仮設定
for i=0 to 8
for j=0 to 8
for k=0 to 8
if flag(i,j)=0 then
q(i,j,k)=k+1
end if
next k
next j
next i
'置数可能数字絞り込み
'既置数済み数字を、置数可能数ｴﾘｱより削除
for p=0 to 80
i=int(p/9)
j=mod(p,9)
bi=int(i/3)*3
bj=int(j/3)*3
if flag(i,j)=1 then
wk=m(i,j) 'wk=初期設定済み升目(i,j)の数字
for iw=0 to 8 '縦行ｻｰﾁ
if flag(iw,j)=0 then 'wkと同じ数字は、置数不可なので
q(iw,j,wk-1)=0 '置数可能数字候補を削除
end if
next iw
for jw=0 to 8 '横行ｻｰﾁ
if flag(i,jw)=0 then 'wkと同じ数字は、置数不可なので
q(i,jw,wk-1)=0 '置数可能数字候補を削除
end if
next jw
'ブロック
for x=0 to 2
for y=0 to 2
if flag(bi+x,bj+y)=0 then
q(bi+x,bj+y,wk-1)=0
end if
next y
next x
end if
next p
'置数可能数左寄せ
'q(i,j,0)=1,q(i,j,3)=3,q(i,j,8)=9 となっていたら
'q(i,j,0)=1,q(i,j,1)=3,q(i,j,2)=9 の様に左詰めにする
for i=0 to 8
for j=0 to 8
if flag(i,j)=0 then
cn2=0
do while cn2<9
cn1=0
do while q(i,j,cn1)<>0
cn1=cn1+1
if cn1=9 then exit do
loop
for k=cn1+1 to 8
q(i,j,k-1)=q(i,j,k)
q(i,j,k)=0
next k
cn2=cn2+1
loop
end if
next j
next i
call draw
call backtrack(0) '解探索、左上からの連番
'----------------------------------------------------------------
function checkrule(row,col,k) '既に同じ数があるかどうか確認する
checkrule=0
for y=0 to 8 '列
if m(y,col)=k then exit function '同じ数が見つかったので、ＮＧ
next y
for x=0 to 8 '行
if m(row,x)=k then exit function '同じ数が見つかったので、ＮＧ
next x
'ブロック
bx=int(col/3)*3
by=int(row/3)*3
for x=0 to 2
for y=0 to 2
if m(by+y,bx+x)=k then exit function '同じ数が見つかったので、ＮＧ
next y
next x
checkrule=1 '同じ数値は見つからないので、ＯＫ
end function
'----------------------------------------------------------------
sub draw
set line width 2
set draw mode hidden
'画面ｸﾘﾔ
line(10,10)-(700,700),1,bf
set text color 5
set text font "ＭＳ 明朝",20
'解ｶｳﾝﾀ表示
plot text, at 150,650:"解個数="
plot text, at 400,650,using "######":cnt
'ﾏｽ目ｲﾝﾃﾞｸｽ描画
for i=0 to 8
plot text, at 120+i*50,550,using "###":i
next i
for j=0 to 8
plot text, at 50,500-j*50,using "###":j
next j
'再描画
set text color 5
for p=0 to 80
row=int(p/9) '行と列に換算する
col=mod(p,9)
set text color 5-flag(col,row)*1
plot text, at 120+row*50,500-col*50,using "###":m(col,row)
next p
'升目罫線描画
for i=0 to 8
for j=0 to 8
line(100+(i+1)*50,500-j*50)-(100+(i+1)*50+50,500-(j-1)*50),5,b
next j
next i
'升目ﾌﾞﾛｯｸ境界線描画
for i=0 to 8 step 3
for j=0 to 8 step 3
line(100+(i+1)*50,500-j*50-100)-(100+(i+3)*50+50,500-(j-3)*50-100),4,b
next j
next i
set draw mode explicit
mouse poll xm,ym,left,right
if right=1 then stop
do while left=1
mouse poll xm,ym,left,right
loop
end sub
'----------------------------------------------------------------
sub backtrack(p) '位置pを調査する
local row,col,i
if p<9*9 then 'すべてが埋まるまで継続
row=int(p/9) '行と列に換算する
col=mod(p,9)
if m(row,col)<>0 then '既に数字があれば
call backtrack(p+1) '次の枡へ
else 'なけらば
for i=0 to 8 '
k=q(row,col,i) '置数可能数をｾｯﾄ
if k=0 then i=8 '0は不可なのでﾊﾟｽ
if checkrule(row,col,k)=1 then '矛盾なく置ければ
m(row,col)=k 'ここに置いてみる
call backtrack(p+1) '次の枡へ
'ここへ戻ったら置数不可なので
m(row,col)=0 '取り消す
end if
next i
'call draw '途中経過表示
end if
else 'すべて埋まったら
'mat print using "# # # # # # # # #": m '解をテキスト画面表示する
'print
cnt=cnt+1 '解ｶｳﾝﾀ＋１
call draw
'input aa$
end if
end sub
|
|