ボンバーパズル

ボンバーパズル
例題（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個隠れている。
③数字は、そのマスにタテ・ヨコ・ナナメで接しているマス（最大８マス）に
隠れている爆弾の数を示す。
④数字のあるマスには爆弾はない。
N
ボンバーパズルは、上記ルールの ③④の式を書くとおしまいである。
変数
J →
1 2
マスの行番号をＩ、列番号をＪとして
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画面に表示する。

Download Report