PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0
PUBLIC STRING num$
LET num$="0123456789ABCDEF" !N進法の数字
DIM M(0 TO N-1,0 TO N-1) !平方の方陣
MAT M=(-1)*CON
SET WINDOW -1,N+1,N+1,-1
DRAW grid
LET t0=TIME
CALL BackTrack(N,M,0) !左上から
PRINT "計算時間=";TIME-t0
END
EXTERNAL SUB BackTrack(N,M(,),p) !(左上からの連番)位置pを調査する
IF p<N*N THEN !すべてが埋まるまで
LET row=INT(p/N) !行と列に換算する
LET col=MOD(p,N)
FOR k=0 TO N*N-1 !0~N*N-1範囲の数字を
CALL CheckRule(N,M, row,col,k, rc)!矛盾なく置ければ
IF rc=1 THEN
SET TEXT COLOR 1
PLOT TEXT ,AT col+0.5,row+0.5: STR$(k)
LET M(row,col)=k !ここに置いてみる
CALL BackTrack(N,M,p+1) !次へ
LET M(row,col)=-1 !取り消す
SET TEXT COLOR 0
PLOT TEXT ,AT col+0.5,row+0.5: STR$(k)
END IF
NEXT k
ELSE !すべて埋まったら
LET ANSWER_COUNT=ANSWER_COUNT+1 !解答数
PRINT ANSWER_COUNT
FOR i=0 TO N-1
FOR j=0 TO N-1
LET t=M(i,j)
LET k1=MOD(t,N)+2 !N進法での各桁の値(文字位置を加味)
LET k2=INT(t/N)+2
PRINT num$(k2:k2); num$(k1:k1); " "; !解を表示する
NEXT j
PRINT
NEXT i
PRINT
END IF
END SUB
EXTERNAL SUB CheckRule(N,M(,), row,col,K, rc) !同じ数があるかどうか確認する
LET rc=0
FOR y=0 TO N-1 !埋まっている範囲で未使用の数字か
FOR x=0 TO N-1
IF y>=row AND x>=col THEN EXIT FOR
IF M(y,x)=K THEN EXIT SUB !見つかったので、NG!
NEXT x
NEXT y
LET k1=MOD(K,N) !N進法での1桁目
LET k2=INT(K/N) !N進法での2桁目
FOR y=0 TO row-1 !列
LET t=M(y,col)
IF MOD(t,N)=k1 THEN EXIT SUB
IF INT(t/N)=k2 THEN EXIT SUB
NEXT y
FOR x=0 TO col-1 !行
LET t=M(row,x)
IF MOD(t,N)=k1 THEN EXIT SUB
IF INT(t/N)=k2 THEN EXIT SUB
NEXT x
PUBLIC STRING num$
LET num$="0123456789ABCDEF" !N進法の数字
DIM M(0 TO N*N-1) !平方の方陣
MAT M=(-1)*CON
FOR i=0 TO N-1 !標準形の場合 ※1行目と1列目が整列している
LET M(i*N+0)=i
LET M(0*N+i)=i
NEXT i
LET t0=TIME
CALL BackTrack(N,M,0) !左上から
PRINT "計算時間=";TIME-t0
END
EXTERNAL SUB BackTrack(N,M(),p) !(左上からの連番)位置pを調査する
IF p<N*N THEN !すべてが埋まるまで
IF M(p)>=0 THEN !既に置いてあれば
CALL BackTrack(N,M,p+1) !次へ
ELSE
FOR k=0 TO N-1 !数字0~N-1を
CALL CheckRule(N,M, p,k, rc)!矛盾なく置ければ
IF rc=1 THEN
LET M(p)=k !ここに置いてみる
CALL BackTrack(N,M,p+1) !次へ
LET M(p)=-1 !取り消す
END IF
NEXT k
END IF
ELSE !すべて埋まったら
LET CntOfLM=CntOfLM+1 !解答数
PRINT CntOfLM
FOR i=0 TO N-1
FOR j=0 TO N-1
LET t=M(i*N+j)+1
PRINT num$(t+1:t+1); " "; !解を表示する
NEXT j
PRINT
NEXT i
PRINT
END IF
END SUB
EXTERNAL SUB CheckRule(N,M(), p,K, rc) !同じ数があるかどうか確認する
LET rc=0
LET row=INT(p/N) !行と列に換算する
LET col=MOD(p,N)
FOR i=0 TO row-1 !列
IF M(i*N+col)=K THEN EXIT SUB
NEXT i
FOR i=0 TO col-1 !行
IF M(row*N+i)=K THEN EXIT SUB
NEXT i
OPTION BASE 0
LET N= 3 ! 2,3,4,5,6
DIM lb(9408,N,N) ! N=1~7: 1,1,1,4,56,9408,16942080 N=7は非現実的
DIM wb(N,N), xidx(N), yidx(N), fb(N,N)
!
CALL main
SUB makelb(x, y)
local i,j
FOR i=0 TO N-1
FOR j=0 TO x-1
IF i=wb(y,j) THEN EXIT FOR ! break;
NEXT j
IF j>x-1 THEN
FOR j=0 TO y-1
IF i=wb(j,x) THEN EXIT FOR ! break;
NEXT j
IF j>y-1 THEN
LET wb(y,x)= i
IF y=N-1 AND x=N-1 THEN
!----memcpy(lb[lbs++], wb, sizeof(wb));
FOR a=0 TO N
FOR b=0 TO N
LET lb(lbs,a,b)=wb(a,b)
NEXT b
NEXT a
LET lbs=lbs+1
!---------------
EXIT SUB ! return;
END IF
IF
y=N-1 THEN CALL makelb(x+1, 1) ELSE CALL makelb((x),y+1)
END IF
END IF
NEXT i
END SUB
SUB echk
local i,j
MAT fb=ZER ! memset(fb, 0, sizeof(fb));
FOR i= 0 TO N-1
FOR j= 0 TO N-1
IF fb( lb(p,i,j), lb(q,yidx(i),xidx(j)) )>0 THEN EXIT SUB ! return;
LET fb( lb(p,i,j), lb(q,yidx(i),xidx(j)) )=1
NEXT j
NEXT i
FOR i= 0 TO N-1
FOR j= 0 TO N-1
PRINT USING "%#": lb(p,i,j)+1, lb(q,yidx(i),xidx(j))+1;
IF j=N-1 THEN PRINT ELSE PRINT " ";
NEXT j
NEXT i
STOP ! exit(0);
END SUB
SUB check1(n_)
local i
FOR i=n_ TO N-1
swap xidx(i),xidx(n_)
!-----check2(n_)
local i_
FOR i_= n_ TO N-1
swap yidx(i_),yidx(n_)
IF ( yidx(n_)<>xidx(n_)) AND (n_<>1 OR yidx(n_)< xidx(n_) ) THEN
IF n_=N-1 THEN CALL echk ELSE CALL check1(n_+1)
END IF
swap yidx(i_),yidx(n_)
NEXT i_
!------
swap xidx(i),xidx(n_)
NEXT i
END SUB
SUB main
FOR i= 0 TO N-1
LET wb(i,0)= i
LET wb(0,i)= i
NEXT i
LET lbs = 0
PRINT "N=";N; ! 追加した表示
CALL makelb(1,1)
PRINT "lbs=";lbs !追加
MAT PRINT wb ! 追加
LET count= 0
FOR p=0 TO lbs-1
FOR q=p TO lbs-1
LET count=count+1
IF MOD(count,1000)=0 THEN PRINT count
FOR i= 0 TO N-1
LET yidx(i)= i
LET xidx(i)= i
NEXT i
CALL check1(1)
NEXT q
NEXT p
PRINT "解は見つかりませんでした."
END SUB
プログラムのお願い
投稿日:2008年11月 1日(土)10時51分27秒確認することをやってみたいのです。
どなたか十進BASICにてプログラムを組んでいただけないでしょうか?
オイラー方陣とは5次なら(2次と6次以外は構成可能と証明されている。)
12 23 34 45 51
53 14 25 31 42
44 55 11 22 33
35 41 52 13 24
21 32 43 54 15
のように、十位と一位にくる数(1~5)が
各行、各列に重複することが起きない。
(ただし25個の数字は全て異なるものとする。)
自分でやっていて、なかなか進展しないものですのでよろしくお願いします。