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

ペントミノをプログラムで解く

　　ペントミノをプログラムで解く 山中和義 2008/06/03 10:37:14 
　　└つづき 山中和義 2008/06/03 10:38:08 
　　　└つづき 山中和義 2008/06/03 10:39:53 
　　　　└つづき（サブルーチン） 山中和義 2008/06/03 10:43:57 
　　　　　└つづき 山中和義 2008/06/03 10:44:52 
　　　　　　├DELETED  島村1243  2008/06/03 13:10:41  (削除)
　　　　　　└DELETED  島村1243  2008/06/03 21:30:01  (削除)

　　ペントミノをプログラムで解く 山中和義 2008/06/03 10:37:14   ツリーへ
ペントミノをプログラムで解く 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/03 10:37:14
!高速化と重複解（回転や対称）の排除への対策
!・片は短辺に沿って置く
!・Ｘ片の配置を盤左上1/4に限定
!　軸対称の位置で２重に探索する　→　3x20 4個、4x15 402個、8x8 130個、5x12 ?個、6x10 ?個


PUBLIC NUMERIC PIECE_COUNT,PIECE_SIZE !共通の定数　※
LET PIECE_COUNT=12 !片の数
LET PIECE_SIZE=5 !正方形の数

SUB get_shape(p, nam$,shape(,)) !形状を得る
SELECT CASE p
CASE 1
RESTORE 01
CASE 2
RESTORE 02
CASE 3
RESTORE 03
CASE 4
RESTORE 04
CASE 5
RESTORE 05
CASE 6
RESTORE 06
CASE 7
RESTORE 07
CASE 8
RESTORE 08
CASE 9
RESTORE 09
CASE 10
RESTORE 10
CASE 11
RESTORE 11
CASE 12
RESTORE 12
CASE ELSE
PRINT "引数が不正です。";p
STOP
END SELECT

READ nam$
MAT READ shape

!ペントミノ（Pentomino）　１２片の定義

!技術メモ
!　Fの場合の形状データ
!　　+0+1+2 →ｘ
!　+0ＦＦ
!　+1　ＦＦ
!　+2　Ｆ
!ｙ↓

!両面型ペントミノ
12 DATA "F"
DATA 0,0 !x,y
DATA 1,0
DATA 1,1
DATA 2,1
DATA 1,2

04 DATA "L"
DATA 0,0
DATA 0,1
DATA 0,2
DATA 0,3
DATA 1,3

05 DATA "N"
DATA 0,0
DATA 0,1
DATA 0,2
DATA 1,2
DATA 1,3

11 DATA "P"
DATA 0,0
DATA 1,0
DATA 0,1
DATA 1,1
DATA 0,2

06 DATA "Y"
DATA 1,0
DATA 0,1
DATA 1,1
DATA 1,2
DATA 1,3

10 DATA "Z"
DATA 0,0
DATA 1,0
DATA 1,1
DATA 1,2
DATA 2,2

!片面型ペントミノ
03 DATA "I"
DATA 0,0
DATA 0,1
DATA 0,2
DATA 0,3
DATA 0,4

07 DATA "T"
DATA 0,0
DATA 1,0
DATA 2,0
DATA 1,1
DATA 1,2

02 DATA "U"
DATA 0,0
DATA 2,0
DATA 0,1
DATA 1,1
DATA 2,1

08 DATA "V"
DATA 0,0
DATA 0,1
DATA 0,2
DATA 1,2
DATA 2,2

09 DATA "W"
DATA 0,0
DATA 0,1
DATA 1,1
DATA 1,2
DATA 2,2

01 DATA "X"
DATA 1,0
DATA 0,1
DATA 1,1
DATA 2,1
DATA 1,2

END SUB
!----------------------------------------
 
　　└つづき 山中和義 2008/06/03 10:38:08   ツリーへ
Re: ペントミノをプログラムで解く 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/03 10:38:08
つづき


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

DIM board$(M,N) !盤
FOR yy=1 TO M !盤の初期化
FOR xx=1 TO N
LET board$(yy,xx)="." !空き
NEXT xx
NEXT yy
LET board$(4,4)=" " !ピリオド以外の文字
LET board$(5,4)=" "
LET board$(4,5)=" "
LET board$(5,5)=" "
CALL display_board(M,N,board$)
!----------------------------------------


PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0

LET a=MAX(M,N)
SET WINDOW 0,a+2,a+2,0 !表示領域


DIM R90(2,2) !９０度回転
90 DATA 0,-1 !(cosθ -sinθ)
DATA 1, 0 !(sinθ cosθ)
RESTORE 90
MAT READ R90

DIM REV(2,2) !裏返す　※Ｙ軸対称
95 DATA -1,0 !scale
DATA 0,1
RESTORE 95
MAT READ REV


!技術メモ
!　すべての向き
!　F0,F1,F2,F3, f0,f1,f2,f3
!　L0,L1,L2,L3, l0,l1,l2,l3
!　N0,N1,N2,N3, n0,n1,n2,n3
!　P0,P1,P2,P3, p0,p1,p2,p3
!　Y0,Y1,Y2,Y3, y0,y1,y2,y3
!　Z0,Z1, z0,z1
!
!　I0,I1
!　T0,T1,T2,T3
!　U0,U1,U2,U3
!　V0,V1,V2,V3
!　W0,W1,W2,W3
!　X0

DIM nam$(PIECE_COUNT),shape(PIECE_COUNT*PIECE_SIZE*8,2) !片のなまえ、８方向の形状

DIM shp(PIECE_SIZE,2)
FOR i=1 TO PIECE_COUNT
CALL get_shape(i, nam$(i),shp) !形状を得る
FOR j=1 TO 2 !裏返し
FOR k=1 TO 4 !回転
LET id=(j-1)*4+k
CALL set_piece(i,id,shp, shape) !記録する

CALL operate_piece(shp,R90) !+90度
NEXT k
CALL operate_piece(shp,REV) !裏返す
NEXT j
NEXT i



DIM piece(PIECE_COUNT,3) !片の向き（使用フラグを兼ねる）、配置位置
MAT piece=ZER

LET t0=TIME

FOR xx=1 TO INT((N-3)/2)+1 !X片を盤の左上1/4に置く
FOR yy=1 TO INT((M-3)/2)+1 !※3=幅、高さ

LET shp1=get_piece(1,1) !形状を得る

CALL check_site(shp1,yy,xx, K, shape, M,N,board$) !うまく置ければ
IF K>PIECE_SIZE THEN

LET piece(1,1)=1 !１番目
LET piece(1,2)=xx
LET piece(1,3)=yy

CALL put_piece(nam$(1),shp1,yy,xx, shape, board$) !配置する
CALL display_board(M,N,board$)

CALL try(2, piece,nam$, shape, M,N,board$, 1,1) !※

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

CALL put_piece(".",shp1,yy,xx, shape, board$) !元に戻す

END IF

NEXT yy
NEXT xx


END
 
　　　└つづき 山中和義 2008/06/03 10:39:53   ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/03 10:39:53
つづき


EXTERNAL SUB try(i, piece(,),nam$(), shape(,), M,N,board$(,), row,col) !試行
FOR j=2 TO PIECE_COUNT !残りの片を使って　※
IF piece(j,1)=0 THEN

LET nm$=UCASE$(nam$(j))

FOR t=1 TO 8 !回転や裏返しを試す

IF nm$="Z" AND MOD(t-1,4)>=2 THEN !点対称は除く
ELSE

LET shp=get_piece(j,t) !形状を得る
CALL fit_piece(shp,row,col, row2,col2, shape) !位置補正

CALL check_site(shp,row2,col2, K, shape, M,N,board$) !うまく置ければ
IF K>PIECE_SIZE THEN

LET piece(j,1)=t !向き　※使用中
LET piece(j,2)=col2 !位置
LET piece(j,3)=row2

CALL put_piece(nam$(j),shp,row2,col2, shape, board$) !片を置く
!!!CALL display_board(M,N,board$) !debug

IF i=PIECE_COUNT THEN !すべて並んだら

LET ANSWER_COUNT=ANSWER_COUNT+1
PRINT ANSWER_COUNT

CALL display_board(M,N,board$) !配置の表示

ELSE !途中なら

SET DRAW mode hidden !配置アニメーション
CLEAR
FOR k=1 TO PIECE_COUNT
IF piece(k,1)>0 THEN
SET AREA COLOR k+1
DRAW display_piece(k,piece(k,1),shape) WITH SHIFT(piece(k,2),piece(k,3))
END IF
NEXT k
DRAW grid
SET DRAW mode explicit

CALL search_site(M,N,board$, row,col, rr,cc) !次の空きマスを探す
!!!PRINT rr;cc

CALL try(i+1, piece,nam$, shape, M,N,board$, rr,cc) !次の片へ

END IF

CALL put_piece(".",shp,row2,col2, shape, board$) !元に戻す

END IF

IF POS("XO",nm$)>0 THEN EXIT FOR !片面型は除く
IF POS("TUVW",nm$)>0 AND t>=4 THEN EXIT FOR
IF nm$="I" AND t>=2 THEN EXIT FOR

END IF

NEXT t

LET piece(j,1)=0 !未使用

END IF
NEXT j
END SUB
 
　　　　└つづき（サブルーチン） 山中和義 2008/06/03 10:43:57   ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/03 10:43:57
つづき（サブルーチン）
!------------------------------ ここからサブルーチン

EXTERNAL SUB display_board(M,N,board$(,)) !盤を表示する
FOR y=1 TO M
FOR x=1 TO N
PRINT board$(y,x);
NEXT x
PRINT
NEXT y
PRINT
END SUB

EXTERNAL PICTURE display_piece(i,f,shp12(,)) !片をグラフィックス表示する
LET tt=get_piece(i,f) !先頭位置
FOR q=1 TO PIECE_SIZE !正方形の数
LET x=shp12(tt+q,1)
LET y=shp12(tt+q,2)
PLOT AREA: x,y; x+1,y; x+1,y+1; x,y+1
NEXT q
END PICTURE


!技術メモ
!　Lの場合
!　　　+0+1
!　　+0Ｌ←回転の基準
!　　+1Ｌ
!　　+2Ｌ
!　　+3ＬＬ
!　時計回りの回転（行列変換 shape*R90）
!　　　-3-2-1+0
!　　+0ＬＬＬＬ
!　　+1Ｌ
!　補正（平行移動）
!　　　+0+1+2+3
!　　+0ＬＬＬＬ
!　　+1Ｌ

EXTERNAL SUB operate_piece(shape(,),R(,)) !片を「90度回転/裏返し」させる
MAT shape=shape*R !各座標の変換

LET dx=0 !「左上詰め」への平行移動量
LET dy=0
FOR i=1 TO PIECE_SIZE !正方形の数
IF shape(i,1)<dx THEN LET dx=shape(i,1) !はみ出し量の最大を求めて
IF shape(i,2)<dy THEN LET dy=shape(i,2)
NEXT i
FOR i=1 TO PIECE_SIZE !左上に詰める
LET shape(i,1)=shape(i,1)-dx
LET shape(i,2)=shape(i,2)-dy
NEXT i
END SUB

EXTERNAL SUB set_piece(i,f,shape(,), shp12(,)) !i番の片の形状fを設定する
LET tt=get_piece(i,f) !先頭位置
FOR q=1 TO PIECE_SIZE !正方形の数
LET shp12(tt+q,1)=shape(q,1) !記録する
LET shp12(tt+q,2)=shape(q,2)
NEXT q
END SUB


EXTERNAL FUNCTION get_piece(i,f) !i番の片の形状fを得る
LET get_piece=((i-1)*8+f-1)*PIECE_SIZE !先頭位置
END FUNCTION

EXTERNAL SUB put_piece(nam$,shp,row,col, shape(,),board$(,)) !片を置く
FOR i=1 TO PIECE_SIZE !正方形の数
LET x=col+shape(shp+i,1)
LET y=row+shape(shp+i,2)
LET board$(y,x)=nam$
NEXT i
END SUB

!技術メモ
!　逆さＴの場合
!　　@T 　　　 T
!　　 T 　⇒　 T
!　　TTT　　　@TT
!　１行１列（row,col）で配置すると隙間が空くので、３行１列目へ（row2,col2）変更する

EXTERNAL SUB fit_piece(shp,row,col, row2,col2, shape(,)) !左上へと配置基準を詰める
LET tmp=999
FOR i=1 TO PIECE_SIZE !正方形の数
IF shape(shp+i,1)=0 THEN !左端の
IF shape(shp+i,2)<tmp THEN LET tmp=shape(shp+i,2) !最初の正方形の行へ
END IF
NEXT i
LET row2=row-tmp
LET col2=col
END SUB
 
　　　　　└つづき 山中和義 2008/06/03 10:44:52   ツリーへ
Re: つづき（サブルーチン） 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/06/03 10:44:52
つづき


EXTERNAL SUB check_site(shp,row,col, K, shape(,), M,N,board$(,)) !片が配置できるか確認する
FOR K=1 TO PIECE_SIZE !正方形の数
LET x=col+shape(shp+K,1)
LET y=row+shape(shp+K,2)
IF x<1 OR x>N THEN EXIT SUB !領域外
IF y<1 OR y>M THEN EXIT SUB
IF board$(y,x)<>"." THEN EXIT SUB !埋まっている
NEXT K
END SUB

EXTERNAL SUB search_site(M,N,board$(,),r,c, row,col) !空きマスを探す
LET col=c !開始位置
LET row=r
DO UNTIL col>N !終端まで
DO UNTIL row>M
IF board$(row,col)="." THEN EXIT SUB !見つかったら
LET row=row+1 !次の行へ
LOOP
LET row=1 !先頭行から
LET col=col+1 !次の桁へ
LOOP

PRINT "空きマスなし。"
CALL display_board(M,N,board$)
STOP
END SUB
 
　　　　　　├DELETED  島村1243  2008/06/03 13:10:41  (削除)  ツリーへ
Re: つづき 返事を書く
島村1243 <bjllmpcujp> 2008/06/03 13:10:41 ** この記事は削除されました 

　　　　　　└DELETED  島村1243  2008/06/03 21:30:01  (削除)  ツリーへ
Re: つづき 返事を書く
島村1243 <bjllmpcujp> 2008/06/03 21:30:01 ** この記事は削除されました

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