パズルの解が知りたい。

 投稿者:GAI  投稿日:2009年 9月11日(金)19時40分13秒
  次の2つのパズルに出くわし、どうしても解きたく1週間挑戦するも歯がたたず、サイトで調べてもどこにも解答らしきものに出会えず、でもどうしても解答が知りたい。
プログラムの力で見つけてもらえないでしょうか。
または、どなたか解答をご存じではないでしょうか?


Rolling Cube1
さいころが9個(3×3)入る箱があり、中央にはさいころがなく、周りに8個のさいころが1の目を下にして配置されている。
さいころを空き地に転がすことで、全てのさいころの目が1が出現するようにせよ。
Rolling Cube2
8×8のオセロ板の左上に1の目を上にしたさいころがある。全てのマス目を1の目が出現しないよう(上の面に1の目が出ない。)に転がしていき、最後に右上のマス目で終了する時初めて1の目が現れること。
 

Re: パズルの解が知りたい。

 投稿者:山中和義  投稿日:2009年 9月11日(金)20時51分23秒
  > No.545[元記事へ]

GAIさんへのお返事です。

「さいころを転がす」を参照のこと。 No.99[元記事へ]

2箇所(プログラムの中央あたり)

LET s$="RRRRRRR" !手順 1

SET WINDOW -1,9,9,-1 !表示領域

を修正してください。転がしていくと動きが見えてくると思います。
 

Re: パズルの解が知りたい。

 投稿者:山中和義  投稿日:2009年 9月13日(日)09時56分11秒
  > No.545[元記事へ]

GAIさんへのお返事です。

> プログラムの力で見つけてもらえないでしょうか。

Rolling Cube 2 を解くプログラム

「マップの経路探索」と「置換」とを組み合わせました。
8×8は非力なパソコンでは一日作業になります。2進モードで実行してください。

!問題
! さいころが1つ、8×8の盤の左上隅に1の面を上に乗っています。
! このさいころを全てのマスを1度だけ通って右上隅に転がして移動させます。
! このとき、途中で1の面が上に来てはいけません。
! 最後に右上隅に来たときは、1の面が上になるようにしてください。

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
      FOR i=1 TO 4 !上下左右の4近傍
         LET ty=yy+DY(i)
         LET tx=xx+DX(i)

         IF DIST=SY*SX AND Cnt<(SY-1)*(SX-1) AND (ty>SY OR tx>SX) THEN !マップを分割することを防ぐ
         ELSE !!!!!※開始位置が最下行以外

            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

         END IF !!!!!

      NEXT i

   END IF

   LET M(yy,xx)=0 !元に戻す

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


>サイトで調べてもどこにも解答らしきものに出会えず、

 

Re: パズルの解が知りたい。

 投稿者:山中和義  投稿日:2009年 9月13日(日)23時28分10秒
  > No.548[元記事へ]

ご迷惑をおかけします。
解も枝刈りしていましたので、正しい結果になりませんでした。

次のように修正してください。
!問題
! さいころが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
 

Re: パズルの解が知りたい。

 投稿者:山中和義  投稿日:2009年 9月15日(火)16時09分21秒
  > No.551[元記事へ]

ベンチマークテスト WindowsME、PentiumⅢ700MHz、RAM192MB にて

「Rolling Cube2を解くプログラム」

> !問題
> ! さいころが1つ、8×8の盤の左上隅に1の面を上に乗っています。
> ! このさいころを全てのマスを1度だけ通って右上隅に転がして移動させます。
> ! このとき、途中で1の面が上に来てはいけません。
> ! 最後に右上隅に来たときは、1の面が上になるようにしてください。

63行
   !SET WINDOW 0,1,1,0 !---------- trace

74行
   !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

の(トレースに使っている)グラフィックス命令をコメントアウトしてください。


●十進BASIC 10進モードによる
No. 1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
 -1  1  2  3  4 61 62 63 64 -1
 -1 10  9  6  5 60 59 56 55 -1
 -1 11  8  7 32 33 58 57 54 -1
 -1 12 27 28 31 34 37 38 53 -1
 -1 13 26 29 30 35 36 39 52 -1
 -1 14 25 24 23 42 41 40 51 -1
 -1 15 18 19 22 43 46 47 50 -1
 -1 16 17 20 21 44 45 48 49 -1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
実行時間= 359.27 秒


●十進BASIC 2進モードによる
No. 1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
 -1  1  2  3  4 61 62 63 64 -1
 -1 10  9  6  5 60 59 56 55 -1
 -1 11  8  7 32 33 58 57 54 -1
 -1 12 27 28 31 34 37 38 53 -1
 -1 13 26 29 30 35 36 39 52 -1
 -1 14 25 24 23 42 41 40 51 -1
 -1 15 18 19 22 43 46 47 50 -1
 -1 16 17 20 21 44 45 48 49 -1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
実行時間= 92.5999999999985 秒


●BASICAccによる
No. 1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
 -1  1  2  3  4 61 62 63 64 -1
 -1 10  9  6  5 60 59 56 55 -1
 -1 11  8  7 32 33 58 57 54 -1
 -1 12 27 28 31 34 37 38 53 -1
 -1 13 26 29 30 35 36 39 52 -1
 -1 14 25 24 23 42 41 40 51 -1
 -1 15 18 19 22 43 46 47 50 -1
 -1 16 17 20 21 44 45 48 49 -1
 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
実行時間= 15.1000000000009 秒
 

戻る