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

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

　　お絵かきロジックをプログラムで解く 山中和義 2008/05/16 18:59:24  (修正1回)
　　├つづき 山中和義 2008/05/16 19:00:30  (修正1回)
　　│└つづき 山中和義 2008/05/16 19:02:01  (修正1回)
　　│　└つづき 山中和義 2008/05/16 19:02:55  (修正1回)
　　└イラストロジックが簡単に解ける！ 片山博文MZ 2008/08/04 13:10:07 

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


!サッカー
LET M=20 !行　※絵の大きさ
LET N=20 !列

LET R=5 !行　※ヒント数字の数
LET C=5 !列

10 DATA 3,0,0,0,0 !1行目　※左詰め
DATA 5,0,0,0,0 !2
DATA 3,1,0,0,0 !3
DATA 2,1,0,0,0 !4
DATA 3,3,4,0,0 !5
DATA 2,2,7,0,0 !6
DATA 6,1,1,0,0 !7
DATA 4,2,2,0,0 !8
DATA 1,1,0,0,0 !9
DATA 3,1,0,0,0 !10
DATA 6,0,0,0,0 !11
DATA 2,7,0,0,0 !12
DATA 6,3,1,0,0 !13
DATA 1,2,2,1,1 !14
DATA 4,1,1,3,0 !15
DATA 4,2,2,0,0 !16
DATA 3,3,1,0,0 !17
DATA 3,3,0,0,0 !18
DATA 3,0,0,0,0 !19
DATA 2,1,0,0,0 !20

DATA 2,0,0,0,0 !1列目　※左詰め
DATA 1,2,0,0,0 !2
DATA 2,3,0,0,0 !3
DATA 2,3,0,0,0 !4
DATA 3,1,1,0,0 !5
DATA 2,1,1,0,0 !6
DATA 1,1,1,2,2 !7
DATA 1,1,3,1,3 !8
DATA 2,6,4,0,0 !9
DATA 3,3,9,1,0 !10
DATA 5,3,2,0,0 !11
DATA 3,1,2,2,0 !12
DATA 2,1,7,0,0 !13
DATA 3,3,2,0,0 !14
DATA 2,4,0,0,0 !15
DATA 2,1,2,0,0 !16
DATA 2,2,1,0,0 !17
DATA 2,2,0,0,0 !18
DATA 1,0,0,0,0 !19
DATA 1,0,0,0,0 !20
!------------------------------ ここまでがデータ


DIM stack_BOARD$(100*M) !盤面保存用のスタック
LET sp_BOARD=0 !スタックポインタ


LET mxMN=MAX(M,N)
LET mxRC=MAX(R,C)

LET t0=TIME
 
　　├つづき 山中和義 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回)  ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/05/16 19:02:01 ** この記事は1回修正されてます
つづき

EXTERNAL SUB thinking(M,N,num(,),cnt(),spc(), mtx$(), rc) !手を進める
DIM w(MAX(M,N)) !ビット列の候補

DO
LET chg=1 !盤面の変化フラグ

FOR k=1 TO M+N !行と列を走査する

!!!PRINT "k=";k


IF k>M THEN !列の場合
FOR i=1 TO M !列方向に換算する
LET ptn$(i:i)=mtx$(i)(k-M:k-M)
NEXT i
LET mn=M
ELSE !行の場合
LET ptn$=mtx$(k)
LET mn=N
END IF

LET wn=0 !候補の数
MAT w=ZER
CALL GenPtn(ptn$,mn, num,k,cnt(k),"",spc(k), w,wn) !候補の生成

IF wn<=0 THEN !※矛盾（候補なし）
IF k>M THEN PRINT "列=";k-M ELSE PRINT "行=";k
LET rc=1
EXIT SUB
END IF


LET t$="" !出現頻度からビットを確定する
FOR i=1 TO mn
IF w(i)=0 THEN !すべてが０の場合
LET t$=t$&"0"
ELSEIF w(i)=wn THEN !すべてが１の場合
LET t$=t$&"1"
ELSE !変動する場合　※1〜個数-1
LET t$=t$&"x"
END IF
NEXT i
!!!PRINT ptn$
!!!PRINT t$; wn !確定ビット、候補の数

IF t$(1:mn)<>ptn$(1:mn) THEN !進展があれば置き換える
IF k>M THEN !列の場合
FOR i=1 TO M !行方向に換算する
LET mtx$(i)(k-M:k-M)=t$(i:i)
NEXT i
ELSE !行の場合
LET mtx$(k)=t$
END IF

LET chg=0
END IF

NEXT k


LET fin=1 !終了フラグ
PRINT
FOR i=1 TO M !完成度を確認しながら、絵を表示する
FOR j=1 TO N
SELECT CASE mtx$(i)(j:j) !ビット列に応じて
CASE "0" !白
PRINT "□"; !"×"
CASE "1" !黒
PRINT "■";
CASE ELSE !未定
PRINT "×"; !"　"
LET fin=0 !未定箇所あり
END SELECT
NEXT j
PRINT
NEXT i
IF fin=1 THEN EXIT DO !すべて確定なら


IF chg=1 THEN !※手詰り（変化なし）
LET rc=2
EXIT SUB
END IF

LOOP

LET rc=0 !※完成
END SUB
 
　　│　└つづき 山中和義 2008/05/16 19:02:55  (修正1回)  ツリーへ
Re: つづき 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/05/16 19:02:55 ** この記事は1回修正されてます
つづき

EXTERNAL SUB GenPtn(ptn$,n, p(,),k,pn,z$,s, w(),wn) !パターン（ptn$）と一致するn桁ビット列の候補を生成する
IF pn>0 THEN !順に埋めていく
FOR i=s TO 0 STEP -1
LET t$="0"&REPEAT$("1",p(k,pn))&REPEAT$("0",i)&z$ !右側から
CALL GenPtn(ptn$,n, p,k,pn-1,t$,s-i, w,wn)
NEXT i

ELSE !すべて埋まったら
LET tmp$=right$(REPEAT$("0",n)&z$,n) !n桁

FOR i=1 TO n !(tmp XOR ptn) AND mask を考える
LET tt$=ptn$(i:i)
IF tt$<>"x" THEN !確定部分を確認する
IF tmp$(i:i)<>tt$ THEN EXIT FOR
END IF
NEXT i
IF i>n THEN !一致する候補を記録する
LET wn=wn+1
FOR j=1 TO n
LET w(j)=w(j)+VAL(tmp$(j:j)) !出現頻度
NEXT j
END IF
END IF
END SUB


!スタック関連
EXTERNAL SUB push(stack$(),sp, v$(),M) !スタックに保存する
IF sp<UBOUND(stack$) THEN
FOR i=1 TO M
LET stack$(sp+i)=v$(i)
NEXT i
LET sp=sp+M
ELSE
PRINT "スタックがオーバーフローです。"
STOP
END IF
END SUB
EXTERNAL SUB pop(stack$(),sp, v$(),M) !スタックから取り出す
IF sp<1 THEN
PRINT "スタックが空です。"
STOP
ELSE
LET sp=sp-M
FOR i=1 TO M
LET v$(i)=stack$(sp+i)
NEXT i
END IF
END SUB
 
　　└イラストロジックが簡単に解ける！ 片山博文MZ 2008/08/04 13:10:07   ツリーへ
Re: お絵かきロジックをプログラムで解く 返事を書く ノートメニュー
片山博文MZ <nmnojyvbut> 2008/08/04 13:10:07
イラストロジックが簡単に解ける！
イラストロジックソルバー
http://www.geocities.co.jp/katayama_hirofumi_mz/ilogic/

イラストロジックというパズルを自動的に解くソフトウェアです。

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