ご迷惑をおかけします。
解も枝刈りしていましたので、正しい結果になりませんでした。
次のように修正してください。
!問題
! さいころが1つ、8×8の盤の左上隅に1の面を上に乗っています。
! このさいころを全てのマスを1度だけ通って右上隅に転がして移動させます。
! このとき、途中で1の面が上に来てはいけません。
! 最後に右上隅に来たときは、1の面が上になるようにしてください。
!その他では、1×1、1×5、2×2、4×2、4×6など
DECLARE EXTERNAL NUMERIC RollCube.A() !外部手続き、変数
DECLARE EXTERNAL NUMERIC Map.ANSWER_COUNT
DECLARE EXTERNAL SUB Map.visit
LET t0=TIME
CALL visit(2,2,1,A) !左上の座標(Y,X)=(1,1) ※外壁を考慮する
IF ANSWER_COUNT=0 THEN PRINT "解なし"
PRINT "実行時間=";TIME-t0;"秒"
END
MODULE Map !マップの構築とその経路探索
SHARE NUMERIC SX,SY !マップの大きさ ※
LET SY=8 !縦
LET SX=8 !横
SHARE NUMERIC M(20,20) !マップ
MAT M=ZER(SY+2,SX+2)
FOR i=1 TO SX+2 !外壁をつくる ※番兵
LET M(1,i)=-1
LET M(SY+2,i)=-1
NEXT i
FOR i=1 TO SY+2
LET M(i,1)=-1
LET M(i,SX+2)=-1
NEXT i
!内壁をつくる ※
!!!MAT PRINT M; !debug
SHARE NUMERIC EX,EY !終点の座標 ※
LET EX=SX+1 !右上隅 ※外壁を考慮する
LET EY=1+1
SHARE NUMERIC DIST !経路を1度だけ通る最大距離
FOR i=2 TO SY+1
FOR j=2 TO SX+1
IF M(i,j)=0 THEN LET DIST=DIST+1
NEXT j
NEXT i
!!!PRINT DIST !debug
PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0
SET WINDOW 0,1,1,0 !---------- trace
PUBLIC SUB vist
EXTERNAL SUB visit(yy,xx,Cnt,T()) !経路(1度だけ通る)を探索する
DECLARE EXTERNAL SUB RollCube.PermMultiply,RollCube.PermPrintOut !外部手続き、変数
DECLARE EXTERNAL NUMERIC RollCube.U(),RollCube.D(),RollCube.L(),RollCube.R()
DECLARE EXTERNAL NUMERIC RollCube.DX(),RollCube.DY()
DIM TT(UBOUND(T)) !作業用
LET M(yy,xx)=Cnt !足跡
SET DRAW mode hidden !---------- trace start
CLEAR
FOR i=1 TO SY+2 !マップを表示する
FOR j=1 TO SX+2
PLOT TEXT, AT 0.06*j,0.06*i: STR$(M(i,j))
NEXT j
NEXT i
SET DRAW mode explicit !---------- trace end
IF (xx=EX AND yy=EY) THEN !終点なら
IF Cnt=DIST AND T(3)=1 THEN !すべてのマスを経由して、1の目なら
LET ANSWER_COUNT=ANSWER_COUNT+1 !解を表示する
PRINT "No.";ANSWER_COUNT
MAT PRINT USING(REPEAT$(" ##",UBOUND(M,2))): M
END IF
ELSE
IF (Cnt>=DIST/5 AND Cnt<=DIST*4/5) AND MOD(Cnt,4)=0 THEN !孤立領域の有無 ※要調整
IF ChkDivdRegion(M)<>0 THEN !あれば、終了!
LET M(yy,xx)=0 !!!!!
EXIT SUB
END IF
END IF
FOR i=4 TO 1 STEP -1 !上下左右の4近傍 ※ケースバイケース
!!FOR i=1 TO 4 !上下左右の4近傍 ※ケースバイケース
LET ty=yy+DY(i)
LET tx=xx+DX(i)
IF M(ty,tx)=0 THEN !未踏なら
SELECT CASE i !さいころを転がしてみる
CASE 1
CALL PermMultiply(T,U,TT)
CASE 2
CALL PermMultiply(T,D,TT)
CASE 3
CALL PermMultiply(T,L,TT)
CASE 4
CALL PermMultiply(T,R,TT)
CASE ELSE
END SELECT
IF Cnt+1=DIST OR TT(3)<>1 THEN CALL visit(ty,tx,Cnt+1,TT) !1の目以外なら、次へ
END IF
NEXT i
END IF
LET M(yy,xx)=0 !元に戻す
END SUB
EXTERNAL FUNCTION ChkDivdRegion(M(,)) !マップが分割されたかどうか確認する
LET ChkDivdRegion=0 !「なし」
LET i=2 !first scan
DO WHILE i<=SY+1
FOR j=2 TO SX+1
IF M(i,j)=0 THEN EXIT DO !1個目が見つかったら
NEXT j
LET i=i+1
LOOP
IF i>SY+1 AND j>SX+1 THEN EXIT FUNCTION !すべて埋まっている
CALL PaintRegion(M,i,j) !その領域を埋める
!!!MAT PRINT M; !debug
LET ChkDivdRegion=1 !「あり」
FOR i=2 TO SY+1 !second scan
FOR j=2 TO SX+1
IF M(i,j)=0 THEN EXIT FUNCTION !他にもあるなら、そこが孤立領域になる
NEXT j
NEXT i
LET ChkDivdRegion=0 !すべて埋まっている
END FUNCTION
EXTERNAL SUB PaintRegion(M(,),i,j) !領域を塗りつぶす
LET M(i,j)=-2
IF M(i-1,j)=0 THEN CALL PaintRegion(M,i-1,j)
IF M(i,j-1)=0 THEN CALL PaintRegion(M,i,j-1)
IF M(i,j+1)=0 THEN CALL PaintRegion(M,i,j+1)
IF M(i+1,j)=0 THEN CALL PaintRegion(M,i+1,j)
END SUB
END MODULE
MODULE RollCube !さいころを転がす
PUBLIC NUMERIC DX(4),DY(4) !上下左右の4近傍
DATA 0,0,-1,1
DATA -1,1, 0,0
MAT READ DX
MAT READ DY
!展開図の配置と面番号(配列の添え字)との関係
! □ 後 1
!□□□□ 左上右下 2345
! □ 正 6
PUBLIC NUMERIC A(6)
DATA 5,4,1,3,6,2 !目の配置 ※展開図参照
MAT READ A
PUBLIC NUMERIC U(6),D(6),L(6),R(6) !置換
! 1,2,3,4,5,6
DATA 3,2,6,4,1,5 !上 ※正面を上面にする(図での水平軸)回転
!!!DATA 5,2,1,4,6,3 !下
DATA 1,3,4,5,2,6 !左
!!!DATA 1,5,2,3,4,6 !右
MAT READ U
CALL PermInverse(U,D)
!!!MAT READ D
MAT READ L
CALL PermInverse(L,R)
!!!MAT READ R
!置換(Permutation)の計算
PUBLIC SUB PermPrintOut
EXTERNAL SUB PermPrintOut(A()) !表示する
MAT PRINT USING(REPEAT$(" ##",UBOUND(A))): A;
PRINT
END SUB
PUBLIC SUB PermIdentity
EXTERNAL SUB PermIdentity(A()) !恒等置換
FOR i=1 TO UBOUND(A)
LET A(i)=i
NEXT i
END SUB
PUBLIC SUB PermInverse
EXTERNAL SUB PermInverse(A(), iA()) !逆置換 ※iAはA以外の配列を指定すること
FOR i=1 TO UBOUND(A)
LET iA(A(i))=i
NEXT i
END SUB
PUBLIC SUB PermMultiply
EXTERNAL SUB PermMultiply(A(),B(), AB()) !積AB ※ABはA以外かつB以外の配列を指定すること
LET ua=UBOUND(A)
LET ub=UBOUND(B)
IF ua=ub THEN
FOR i=1 TO ua
LET AB(i)=A(B(i)) !※合成写像(AB)(i)=A(B(i))
NEXT i
ELSE
PRINT "次元が違います。A=";ua;" B=";ub
STOP
END IF
END SUB
END MODULE