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

お絵かきロジックをプログラムで解く

　　お絵かきロジックをプログラムで解く 山中和義 2008/05/16 18:59:24  (修正1回)
　　├つづき 山中和義 2008/05/16 19:00:30  (修正1回)
Re: お絵かきロジックをプログラムで解く 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/05/16 19:00:30 ** この記事は1回修正されてます
つづき

DIM num(M+N,mxRC) !ヒント数字
MAT num=ZER
RESTORE 10
FOR i=1 TO M !行
FOR j=1 TO R
READ num(i,j)
NEXT j
NEXT i
FOR i=1 TO N !列
FOR j=1 TO C
READ num(i+M,j)
NEXT j
NEXT i

DIM cnt(M+N) !ヒント数字の数
FOR i=1 TO M+N
LET CntOfNum=0
FOR j=1 TO mxRC
IF num(i,j)>0 THEN LET CntOfNum=CntOfNum+1
NEXT j
LET cnt(i)=CntOfNum
NEXT i

DIM spc(M+N) !空白の数
FOR i=1 TO M+N
LET CntOfSpc=0
FOR j=1 TO mxRC
LET CntOfSpc=CntOfSpc+num(i,j) !パターンの長さ
NEXT j
IF i>M THEN !列の場合
LET mn=M
ELSE !行の場合
LET mn=N
END IF
LET spc(i)=mn-(CntOfSpc+(cnt(i)-1)) !間には少なくとも１つの空白が必要である
NEXT i

DIM mtx$(M) !盤面　※行を基準にしたビット列
FOR i=1 TO M
LET mtx$(i)=REPEAT$("x",N) !0:0確定、1:1確定、x:未定
NEXT i


DO !バックトラック
CALL thinking(M,N,num,cnt,spc, mtx$, rc) !手を進める
PRINT "rc=";rc

IF rc=0 THEN !完成なら
EXIT DO
ELSEIF rc=1 THEN !矛盾なら
CALL pop(stack_BOARD$,sp_BOARD, mtx$,M) !次の手

PRINT "次の手"
ELSEIF rc=2 THEN !手詰まりなら
FOR k=1 TO M !左上から順に未定箇所を探し、そこへ仮に置いてみる
LET p=POS(mtx$(k),"x")
IF p>0 THEN EXIT FOR
NEXT k
IF k>M THEN !すべて埋まっていたら
PRINT "解答なし！" !※ヒントの数字に問題あり
STOP
END IF
PRINT "(";k;",";p;")"
LET mtx$(k)(p:p)="1" !「黒」（次の手）を保存しておく
CALL push(stack_BOARD$,sp_BOARD, mtx$,M)

LET mtx$(k)(p:p)="0" !まずは「白」から
END IF

LOOP

PRINT "計算時間=";TIME-t0
PRINT
PRINT "完成！"

END
 
　　│└つづき 山中和義 2008/05/16 19:02:01  (修正1回)
　　│　└つづき 山中和義 2008/05/16 19:02:55  (修正1回)
　　└イラストロジックが簡単に解ける！ 片山博文MZ 2008/08/04 13:10:07

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