ボンバーパズル 例題(2014年2月8日 毎日新聞より) 2 2 解答 ● 2 4 1 3 5 2 4 3 4 3 3 5 ● ● ● ● 4 2 ● 4 ● 2 3 2 1 3 3 2 3 ● ● ● 3 ● ● 5 ● ● 2 2 ● ● ● ● 2 5 2 ● 4 ● 3 3 2 ● 4 2 3 ● ● 4 ● ルール ①パズル面に隠されたすべての爆弾をつきとめる。 ②爆弾は1マスにつき1個隠れている。 ③数字は、そのマスにタテ・ヨコ・ナナメで接しているマス(最大8マス)に 隠れている爆弾の数を示す。 ④数字のあるマスには爆弾はない。 N ボンバーパズルは、上記ルールの ③④の式を書くとおしまいである。 変数 J → 1 2 マスの行番号をI、列番号をJとして b(I,J) = 1 マス (I,J) に爆弾があるとき =0 〃 ないとき とすると 3 . . . 4 Nc I 1 ↓ 2 3 . . . Nr 目的関数 minimize x (ダミー) 制約式 subject to 数字Nのあるマスの座標を(In,Jn)として b(In,Jn)=0 b(In-1,Jn-1)+b(In,Jn-1)+b(In+1,Jn-1)+b(In+1,Jn) +b(In+1,Jn+1)+b(In,Jn+1)+b(In-1,Jn+1)+b(In-1,Jn)=N 上下界 bounds 変数型 binary b(I,J) 終端 end (I=1,2….…Nr) (J= 1,2.…… Nc ) } (数字のあるマスすべてについて 座標 (In+1,Jn-1) など周辺部調整必要) 数字の入ったマスは、変数から除外してしまってもよいが、入力ファイルを作るプログラムに 判定条件が付いてまわり、全マス扱った方がコードが簡単になる。 Excel VBA でCPLEXの .LP形式ファイルを作り出し問題を解くプログラムリストを添付する。 なお、Excelの入力は下図のように、右下に1文字入れてマスの範囲を読むようになっている。 ボンバーパズルでは、数字が最終行、最終列に存在しないということはないが、他のゲーム では、あることなので統一した。ダイアログを出して行数、列数を入力するのはデバッグの際 面倒である。 1 2 3 2 1 4 5 2 6 7 4 1 2 3 3 5 4 5 2 8 lp-File output 3 4 3 4 3 2 6 7 8 2 5 exec SCIP.exe read Solution 3 2 2 3 4 E 範囲読み込みよう文字 Btn1.txt Option Explicit Private Sub CommandButton1_Click() Dim I As Integer, J As Integer, K As Integer, L As Integer Dim Ip As Integer, Im As Integer, Jp As Integer, Jm As Integer Dim Nr As Integer, Nc As Integer, Ng As Integer Dim R(20, 20) As Integer Dim Line As String, LineA As String Dim Flag As Integer Dim Ret As Variant, lastRow As Integer, lastCol As Integer ' ChDrive Left(Application.ThisWorkbook.Path, 1) ChDir Application.ThisWorkbook.Path ' ' find Input Range lastRow = 0 For I = 1 To 20 K = ActiveSheet.Cells(Rows.Count, I).End(xlUp).Row If K > lastRow Then lastRow = K Next I Nr = lastRow - 1 ' lastCol = 0 For J = 1 To 20 K = Cells(J, ActiveSheet.Columns.Count).End(xlToLeft).Column If K > lastCol Then lastCol = K Next J Nc = lastCol - 1 ' For I = 1 To Nr For J = 1 To Nc If IsNumeric(Cells(I, J)) = True Then R(I, J) = Cells(I, J).Value End If Next J Next I ' For I = 1 To Nr Line = "" For J = 1 To Nc Line = Line & Str(R(I, J)) Next J Debug.Print Line Next I ' '=================================================================================== Open "BomberPuzzle.lp" For Output As #1 ' ' Write the problem in CPLEX format ' variable b(I,J) = 1 when Bomb in cell(I,J) Line = "Minimize" Print #1, Line Line = " value: x" Print #1, Line ' ' constraints Line = "Subject To" Print #1, Line ' For I = 1 To Nr For J = 1 To Nc Ip = I + 1 Im = I - 1 Jp = J + 1 Jm = J - 1 If R(I, J) > 0 Then Line = " CELL(" & LTrim(Str(I)) & "," & LTrim(Str(J)) & ")_" & LTrim(Str(R(I, J))) & ":" Line = Line & " b(" & LTrim(Str(I)) & "," & LTrim(Str(J)) & ") = 0" Print #1, Line ' Line = " Around(" & LTrim(Str(I)) & "," & LTrim(Str(J)) & ")" & ":" If Im > 0 And Jm > 0 Then Line = Line & " + b(" & LTrim(Str(Im)) & "," & LTrim(Str(Jm)) & ")" End If ページ(1) Btn1.txt If Jm > 0 Then Line = Line & " + b(" & LTrim(Str(I)) & "," & LTrim(Str(Jm)) & ")" End If If Ip <= Nr And Jm > 0 Then Line = Line & " + b(" & LTrim(Str(Ip)) & "," & LTrim(Str(Jm)) & ")" End If If Ip <= Nr Then Line = Line & " + b(" & LTrim(Str(Ip)) & "," & LTrim(Str(J)) & ")" End If If Ip <= Nr And Jp <= Nc Then Line = Line & " + b(" & LTrim(Str(Ip)) & "," & LTrim(Str(Jp)) & ")" End If If Jp <= Nc Then Line = Line & " + b(" & LTrim(Str(I)) & "," & LTrim(Str(Jp)) & ")" End If If Im > 0 And Jp <= Nc Then Line = Line & " + b(" & LTrim(Str(Im)) & "," & LTrim(Str(Jp)) & ")" End If If Im > 0 Then Line = Line & " + b(" & LTrim(Str(Im)) & "," & LTrim(Str(J)) & ")" End If Line = Line & " = " & LTrim(Str(R(I, J))) Print #1, Line End If Next J Next I ' ---------------------------------------------------------------------------------------' binding constraints Line = "Bounds" Print #1, Line ' ' --------------------------------------------------------------------------------------' variables Line = "Binary" Print #1, Line ' For I = 1 To Nr Line = "" For J = 1 To Nc Line = Line & " b(" & LTrim(Str(I)) & "," & LTrim(Str(J)) & ")" Next J Print #1, Line Next I ' Line = "General" Print #1, Line ' ' --------------------------------------------------------------------------------------Line = "End" Print #1, Line ' Ret = MsgBox("BomberPuzzle.lp 作成しました。", vbOKOnly, "ファイル") ' Close #1 End Sub ページ(2) Private Sub CommandButton2_Click() Dim Line As String ' ChDrive Left(Application.ThisWorkbook.Path, 1) ChDir Application.ThisWorkbook.Path ' Open "script.txt" For Output As #3 ' Line = "read BomberPuzzle.lp " Print #3, Line Line = "optimize" Print #3, Line Line = "write solution BomberPuzzle.sol" Print #3, Line Close #3 ' ' Open "BomberPuzzle.bat" For Output As #4 Line = "..¥scip.exe < script.txt" Print #4, Line ' Close #4 ' Call Shell("BomberPuzzle.bat", vbReadOnly) ' End Sub 一つ上のフォルダーにある整数計画法プログラム、scip.exe を動かして、BomberPuzzle.lpを 解くバッチファイルを実行する。scip.exeの元の名前にはVersionNoなどが付いていたと思うが renameして簡略化した。 SCIPの無償使用は、アカデミックユーザーのみとなっていて、ダウンロード画面には、研究所 大学名など入力するようになっているが、その画面を良く見ると、入力しなくてもダウンロード はできますと書いてある。事実ダウンロードボタンを押しさえすればダウンロードできる。 このソフトはインストール作業を必要とせず、OSが合っていれば、exeファイルをコピーするだけ で実行できるので、どこかのパソコンにあったらコピーして盗んでくれば使える。営利目的に使用 しているのが見つかると、目の玉の飛び出すような金額を請求される恐れがあるが、個人で使用 する分にはフリーソフトと考えてよい。 Private Sub CommandButton3_Click() Dim TextLine As String Dim I As Integer, J As Integer, K As Integer, L1 As Integer, L2 As Integer Dim Length As Integer ' ChDrive Left(Application.ThisWorkbook.Path, 1) ChDir Application.ThisWorkbook.Path ' ' Open "BomberPuzzle.sol" For Input As #2 ' Do While Not EOF(2) Line Input #2, TextLine If Left(TextLine, 1) = "b" Then Length = InStr(TextLine, " ") - 1 ' L1 = InStr(TextLine, "(") L2 = InStr(TextLine, ",") I = Val(Mid(TextLine, L1 + 1, L2 - L1 - 1)) J = Val(Mid(TextLine, L2 + 1, Length - L2 - 1)) Cells(I, J) = "●" End If Loop ' Close #2 End Sub SCIPの解析結果ファイル、BomberPuzzle.solを読み込んで、Excel画面に表示する。
© Copyright 2024