LET k=4 ! 4行
LET n=k*(k+1)/2 ! n=10
DIM a(k,k),check(n)
FOR maxn=1 TO CEIL(k/2)
FOR r=1 TO n^(n/2)
MAT check=ZER
LET a(1,maxn)=n
LET check(n)=1
FOR i=1 TO k
FOR j=1 TO k+1-i
IF NOT (i=1 AND j=maxn) THEN
DO
LET
num=INT((n-1)*RND)+1
LOOP UNTIL check(num)=0
LET a(i,j)=num
LET check(num)=1
END IF
NEXT j
NEXT i
!MAT PRINT a
CALL diff
IF p=0 THEN MAT PRINT a
LET p=0
NEXT r
NEXT maxn
SUB diff
FOR i=1 TO k-1
FOR j=1 TO k-i
IF ABS(a(i,j)-a(i,j+1))<>a(i+1,j) THEN
LET p=1
EXIT SUB
END IF
NEXT j
NEXT i
END SUB
END
PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0
LET K=5 !段数 ※1～
LET N=K*(K+1)/2 !１～Ｋまでの数字
DIM A(N)
MAT A=ZER
LET t0=TIME
PRINT K;"段"
PRINT "1 ～";N;"までの数字"
CALL backtrack(1,K,N,A)
IF ANSWER_COUNT=0 THEN PRINT "解なし"
PRINT "計算時間=";TIME-t0
END
EXTERNAL SUB backtrack(p,K,N,A())
FOR nm=1 TO N
LET A(p)=nm !仮に設定してみる
CALL checkrule(p,nm,N,A, rc) !条件を満たすなら
IF rc=1 THEN
IF p=N THEN !すべて埋まったら
LET ANSWER_COUNT=ANSWER_COUNT+1
PRINT ANSWER_COUNT;"個目"
FOR i=K TO 1 STEP -1 !上段から
PRINT REPEAT$(" ",K-i); !右へシフト
FOR j=1 TO i !この段の数字の数
PRINT USING "###": A((i-1)*i/2+j);
NEXT j
PRINT
NEXT i
!!!MAT PRINT A;
ELSE
CALL backtrack(p+1,K,N,A) !次へ
END IF
END IF
LET A(p)=0 !元に戻す
NEXT nm
END SUB
EXTERNAL SUB checkrule(p,nm,N,M() ,rc) !条件が満たすかどうか確認する
LET rc=0
!●数字は重複していないか？
FOR i=1 TO p-1
IF nm=M(i) THEN EXIT SUB !見つかったのでＮＧ！
NEXT i
!●上段の２数の差？
!M(p)の添え字番号と配置
!11 12 … ５段目 s=11
! 7 8 9 10 ４段目 s=7
! 4 5 6 ３段目 s=4
! 2 3 ２段目 s=2
! 1 １段目 s=1
!
!M(p-1) M(p) x段目
! M(p-x)
LET a=1/2 !段数を得る ※xの２次方程式(x-1)*x/2+1-p=0の解
LET b=-1/2
LET c=1-p
LET D=b^2-4*a*c !判別式 ※この解は実数のみ
LET x=INT((-b+SQR(D))/(2*a))
IF x>1 THEN !２段目以降なら
IF p>(x-1)*x/2+1 THEN !この段の２列目以降なら
IF ABS(M(p-1)-M(p))<>M(p-x) THEN EXIT SUB !不成立なのでＮＧ！
END IF
END IF
!●左右対称
IF p=N AND M(p)<M(p-x+1) THEN EXIT SUB !上段の左端と右端
LET rc=1 !ＯＫ！
END SUB
PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0
LET K=5 !段数 ※1～
LET N=K*(K+1)/2 !１～Ｎまでの数字
DIM F(N),FF(N),B(K),BB(K)
MAT F=ZER
MAT B=ZER
LET t0=TIME
PRINT K;"段"
PRINT "1 ～";N;"までの数字"
CALL perm(1,N,K, F,B,FF,BB)
IF ANSWER_COUNT=0 THEN PRINT "解なし"
PRINT "計算時間=";TIME-t0
END
EXTERNAL SUB perm(p,N,R, F(),B(),FF(),BB()) !順列nPrを生成する
FOR nm=1 TO N !上段のＫ個の数を決める
IF F(nm)=0 THEN !数字は重複なしに埋める
LET F(nm)=1 !使用中とする
LET B(p)=nm !仮に設定してみる
IF p=R THEN !すべて埋まったら
CALL checkrule(R,F,B,FF,BB, rc) !条件を満たすなら
IF rc=1 THEN
LET ANSWER_COUNT=ANSWER_COUNT+1
PRINT ANSWER_COUNT;"個目"
MAT BB=B
FOR j=1 TO R !上段
PRINT USING "###": BB(j);
NEXT j
PRINT
FOR i=R-1 TO 1 STEP -1 !下段へ
PRINT REPEAT$(" ",R-i); !右へシフト
FOR j=1 TO i !この段の数字の数
LET BB(j)=ABS(BB(j)-BB(j+1))
PRINT USING "###": BB(j);
NEXT j
PRINT
NEXT i
END IF
ELSE
CALL perm(p+1,N,R, F,B,FF,BB) !次へ
END IF
LET B(p)=0 !元に戻す
LET F(nm)=0
END IF
NEXT nm
END SUB
EXTERNAL SUB checkrule(K,F(),B(),FF(),BB(), rc) !条件が満たすかどうか確認する
LET rc=0
!●左右対称
IF B(1)>B(K) THEN EXIT SUB !上段の左端と右端
!●上段の２数の差？
MAT BB=B !作業配列へ
MAT FF=F
FOR x=K-1 TO 1 STEP -1 !x段目
FOR j=1 TO x !１つ下の段
LET p=ABS(BB(j)-BB(j+1))
IF FF(p)=1 THEN EXIT SUB !数字が重複していないか
LET BB(j)=p
LET FF(p)=1 !使用中とする
NEXT j
NEXT x
LET rc=1 !ＯＫ！
END SUB
疑問
投稿日：2008年11月16日(日)07時09分52秒２
と配列すれば、上の段の２数の差が（ただし大きい方から小さい方を引く。３－１）
下の数となる。
この規則を敷衍し
１から６までの数字を一度だけ使用して
● ● ●
● ●
●
の位置に入れたい。
試行錯誤の後、６ ２ ５
４ ３
１
なる配列が（もちろん他のパターンも存在すると思う。）求められる。
しかし、
次からが人間には限界が出てきて、
では、１～１０の数字を一度だけ使用して
● ● ● ●
● ● ●
● ●
●
の配列を構成
さらに、１～１５の数字で
● ● ● ● ●
● ● ● ●
● ● ●
● ●
●
１～２１で
● ● ● ● ● ●
● ● ● ● ●
● ● ● ●
● ● ●
● ●
●
・・・・
・・・・
は構成可能なのだろうか？
この問題を解決してもらいたい。