新しく発言する EXIT インデックスへ

箱入り娘をプログラムで解く

　　箱入り娘をプログラムで解く 山中和義 2008/06/15 19:17:14 
　　└つづき 山中和義 2008/06/15 19:18:29 
　　　└つづき 山中和義 2008/06/15 19:21:16 
　　　　└つづき 山中和義 2008/06/15 19:21:54 

　　箱入り娘をプログラムで解く 山中和義 2008/06/15 19:17:14   ツリーへ
箱入り娘をプログラムで解く 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/15 19:17:14


LET BUFFER_SIZE=30000 !バッファの大きさ ※

LET M=5 !行 ※盤の大きさ
LET N=4 !列

LET PIECE_SIZE=10 !駒の数 ※
!LET PIECE_SIZE=11 !駒の数 ※

!技術メモ
!　0:空き
!　1:1x1
!　2:1x2（横長）
!　3:2x1（縦長）
!　4:2x2（娘）
!駒= 0,1,2,3,4,5,6,7,8,9,A,B
DATA 0,3,3,3,3,2,1,1,1,1,4 !駒との対応 ※
!DATA 0,3,3,3,3,1,1,1,1,1,1,4 !駒との対応 ※

DATA "1AA2" !盤の初期配置　※
DATA "1AA2"
DATA "3554"
DATA "3674"
DATA "8009"
!DATA "1BB2" !盤の初期配置　※
!DATA "1BB2"
!DATA "3564"
!DATA "3784"
!DATA "900A"
!------------------------------ ここまでがデータ


DIM shp(0 TO PIECE_SIZE) !駒の型番
MAT READ shp

DIM b$(BUFFER_SIZE) !局面
LET b$(1)=""
FOR j=1 TO M
READ xx$
LET b$(1)=b$(1)&xx$
NEXT j

DIM c$(BUFFER_SIZE) !正規化した局面
CALL normalize_board(M,N,b$(1), shp, c$(1))

DIM Lvl(BUFFER_SIZE) !手数
MAT Lvl=ZER
DIM BNo(BUFFER_SIZE) !１つ前の局面番号
MAT BNo=ZER

DIM x$(8) !次の局面の候補

LET tail=1 !局面の追加位置（末尾）

LET minLvl=200 !最小手数（仮）　※
DIM head(-1 TO minLvl) !i番目の手のバッファ上での先頭位置
LET head(-1)=1 !-1手　※番兵
LET head(0)=1 !０手
LET iLvl=0


LET t0=TIME

LET i=1 !展開中の局面
DO
!!!PRINT "No.";i;"(";Lvl(i);"手　";Bno(i);"から)" !debug
!!!CALL display_board(M,N,b$(i)) !debug

IF c$(i)(18:19)="44" THEN !クリアなら
!IF c$(i)(14:15)="44" AND c$(i)(18:19)="44" THEN !クリアなら
IF Lvl(i)>minLvl THEN EXIT DO
LET minLvl=Lvl(i) !最小手数を記録する

CALL display_answer(i, Lvl,Bno, M,N,b$)

ELSE

 
　　└つづき 山中和義 2008/06/15 19:18:29   ツリーへ
Re: 箱入り娘をプログラムで解く 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/15 19:18:29
つづき


CALL move_piece(M,N,b$(i), shp, xn,x$) !一手進める

FOR k=1 TO xn !すべての候補について

CALL normalize_board(M,N,x$(k), shp, xx$) !正規化

!FOR j=1 TO tail !既存の局面かどうか確認する
FOR j=head(Lvl(i)-1) TO tail !既存の局面（i-1,i,i+1手）かどうか確認する
IF xx$=c$(j) THEN EXIT FOR
NEXT j
IF j>tail THEN !新規なら追加する
LET tail=tail+1

LET c$(tail)=xx$ !正規化した局面
LET b$(tail)=x$(k) !局面
LET Lvl(tail)=Lvl(i)+1 !手数
LET BNo(tail)=i !１つ前　※解をたどるため
END IF

NEXT k

END IF


IF Lvl(i)>iLvl THEN !先頭位置を記録する
LET iLvl=Lvl(i)
LET head(iLvl)=i
END IF


LET i=i+1 !次へ
LOOP WHILE i<=tail !すべての局面を探索したら

PRINT tail !debug


PRINT "計算時間=";TIME-t0

PRINT "終了！"


SUB move_piece(M,N,b$, shp(), xn,x$()) !駒を１マス移動させる
LET xn=0 !手の数

FOR j=1 TO PIECE_SIZE !すべての駒について
IF j>9 THEN LET t$=CHR$(j-10+ORD("A")) ELSE LET t$=STR$(j)
FOR k=1 TO M*N !配置位置を得る
IF t$=b$(k:k) THEN EXIT FOR
NEXT k

LET col=MOD(k,N) !行と列の位置を得る
LET row=INT((k-1)/N)

SELECT CASE shp(j) !駒の形状に応じて
CASE 1 !1x1
IF col<>0 THEN !右端以外なら、右
IF b$(k+1:k+1)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+1:k+1)=b$(k:k) !swap it
LET x$(xn)(k:k)="0"
END IF
END IF
IF row>0 THEN !上端以外なら、上
IF b$(k-N:k-N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-N:k-N)=b$(k:k)
LET x$(xn)(k:k)="0"
END IF
END IF
IF col<>1 THEN !左端以外なら、左
IF b$(k-1:k-1)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-1:k-1)=b$(k:k)
LET x$(xn)(k:k)="0"
END IF
END IF
IF row<M-1 THEN !下端以外なら、下
IF b$(k+N:k+N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+N:k+N)=b$(k:k)
LET x$(xn)(k:k)="0"
END IF
END IF

 
　　　└つづき 山中和義 2008/06/15 19:21:16   ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/15 19:21:16
つづき

CASE 2 !1x2（横長）
IF col<>3 THEN !右端以外なら、右
IF b$(k+2:k+2)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+2:k+2)=b$(k:k)
LET x$(xn)(k:k)="0"
END IF
END IF
IF row>0 THEN !上端以外なら、上
IF b$(k-N:k+1-N)="00" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-N:k+1-N)=b$(k:k+1)
LET x$(xn)(k:k+1)="00"
END IF
END IF
IF col<>1 THEN !左端以外なら、左
IF b$(k-1:k-1)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-1:k-1)=b$(k:k)
LET x$(xn)(k+1:k+1)="0"
END IF
END IF
IF row<M-1 THEN !下端以外なら、下
IF b$(k+N:k+1+N)="00" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+N:k+1+N)=b$(k:k+1)
LET x$(xn)(k:k+1)="00"
END IF
END IF

CASE 3 !2x1（縦長）
IF col<>0 THEN !右端以外なら、右
IF b$(k+1:k+1)="0" AND b$(k+1+N:k+1+N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+1:k+1)=b$(k:k)
LET x$(xn)(k+1+N:k+1+N)=b$(k:k)
LET x$(xn)(k:k)="0"
LET x$(xn)(k+N:k+N)="0"
END IF
END IF
IF row>0 THEN !上端以外なら、上
IF b$(k-N:k-N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-N:k-N)=b$(k:k)
LET x$(xn)(k+N:k+N)="0"
END IF
END IF
IF col<>1 THEN !左端以外なら、左
IF b$(k-1:k-1)="0" AND b$(k-1+N:k-1+N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-1:k-1)=b$(k:k)
LET x$(xn)(k-1+N:k-1+N)=b$(k:k)
LET x$(xn)(k:k)="0"
LET x$(xn)(k+N:k+N)="0"
END IF
END IF
IF row<M-2 THEN !下端以外なら、下
IF b$(k+2*N:k+2*N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+2*N:k+2*N)=b$(k:k)
LET x$(xn)(k:k)="0"
END IF
END IF

CASE 4 !2x2（娘）
IF col<>3 THEN !右端以外なら、右
IF b$(k+2:k+2)="0" AND b$(k+2+N:k+2+N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+2:k+2)=b$(k:k)
LET x$(xn)(k+2+N:k+2+N)=b$(k:k)
LET x$(xn)(k:k)="0"
LET x$(xn)(k+N:k+N)="0"
END IF
END IF

 
　　　　└つづき 山中和義 2008/06/15 19:21:54   ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/15 19:21:54
つづき

!IF row>0 THEN !上端以外なら、上
! IF b$(k-N:k+1-N)="00" THEN
! LET xn=xn+1
! LET x$(xn)=b$
! LET x$(xn)(k-N:k+1-N)=b$(k:k+1)
! LET x$(xn)(k+N:k+1+N)="00"
! END IF
!END IF
IF col<>1 THEN !左端以外なら、左
IF b$(k-1:k-1)="0" AND b$(k-1+N:k-1+N)="0" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k-1:k-1)=b$(k:k)
LET x$(xn)(k-1+N:k-1+N)=b$(k:k)
LET x$(xn)(k+1:k+1)="0"
LET x$(xn)(k+1+N:k+1+N)="0"
END IF
END IF
IF row<M-2 THEN !下端以外なら、下
IF b$(k+2*N:k+1+2*N)="00" THEN
LET xn=xn+1
LET x$(xn)=b$
LET x$(xn)(k+2*N:k+1+2*N)=b$(k:k+1)
LET x$(xn)(k:k+1)="00"
END IF
END IF

CASE ELSE !0

END SELECT
NEXT j
END SUB

SUB display_answer(i, Lvl(),Bno(), M,N,b$()) !解を表示する
DIM p(0 TO 200) !手数における局面番号　※
MAT p=ZER
LET j=i
DO UNTIL j=0 !前方へポインタをたどる
LET p(Lvl(j))=j
LET j=Bno(j)
LOOP

PRINT Lvl(i);"手の解（手順）"
MAT PRINT p; !debug
FOR j=0 TO Lvl(i)
PRINT Lvl(p(j));"手目"
CALL display_board(M,N,b$(p(j))) !盤の表示
NEXT j

PRINT
END SUB

SUB normalize_board(M,N,x$, shp(), xx$) !局面を正規化する
LET xx$=""
FOR j=1 TO M*N
IF x$(j:j)>="A" THEN !A,B,C,…
LET t=ORD(x$(j:j))-ORD("A")+10
ELSE !0,1,2,…,8,9
LET t=VAL(x$(j:j))
END IF
LET xx$=xx$&STR$(shp(t)) !形状番号へ
NEXT j
END SUB

SUB display_board(M,N,b$) !盤を表示する
FOR k=0 TO M-1
PRINT b$(k*N+1:k*N+N)
NEXT k

PRINT
END SUB

END

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。