目盛りの付いていない４ℓ、５ℓ、９ℓの計量カップがあります。９ℓの計量カップは、９ℓ分のお酒で満たされています。この三つの計量カップを使って３ℓに三分割することができるでしょうか？
大事なルール：このパズルのルールは、「容器から別の容器へ、元の容器が空になるか、移し先が満杯になるまで注ぐこと」です。目分量での計量はできません。
まず、3つの計量カップの状態を定義します。全体のお酒の量は常に9ℓになるはずです。
① VBAのModule1に次のコードを記載します。
Option Explicit
' ４、５、９リットルの計量カップ内の酒の量を表す構造体
Public Type StateType
v4 As Long
v5 As Long
v9 As Long
End Type
Public Function makeMeasuringCupState() As StateType()
' 単純なループカウンタ
Dim i4 As Long, i5 As Long, i9 As Long
' 戻り値作成用配列
Dim ret() As StateType
' お酒の分配方法の数をカウントする変数
Dim cnt As Long
cnt = 0
' お酒の分配状態を調べる。
For i4 = 0 To 4
For i5 = 0 To 5
For i9 = 0 To 9
' 三つの計量カップのお酒の量が９?になることが条件。
If i4 + i5 + i9 = 9 Then
cnt = cnt + 1
ReDim Preserve ret(cnt) As StateType
ret(cnt).v4 = i4
ret(cnt).v5 = i5
ret(cnt).v9 = i9
End If
Next i9
Next i5
Next i4
' 戻り値を返す。
makeMeasuringCupState = ret
End Function
Public Sub test_makeMeasuringCupState()
' 単純なループカウンタ
Dim lp As Long
' お酒の分配方法を作る。
Dim state() As StateType
state = makeMeasuringCupState
' すべてのお酒の分配方法を書き出す。
With Range("A1")
.Offset(0, 0).Value = "状態番号"
.Offset(0, 1).Value = "４リットル"
.Offset(0, 2).Value = "５リットル"
.Offset(0, 3).Value = "９リットル"
End With
For lp = 1 To UBound(state)
With Range("A1")
.Offset(lp, 0).Value = "状態" & lp
.Offset(lp, 1).FormulaR1C1 = "=REPT(""■""," & state(lp).v4 & ")"
.Offset(lp, 2).FormulaR1C1 = "=REPT(""■""," & state(lp).v5 & ")"
.Offset(lp, 3).FormulaR1C1 = "=REPT(""■""," & state(lp).v9 & ")"
End With
Next lp
MsgBox "答えは" & UBound(state) & "件見つかりました。" _
, vbInformation
' メモリを解放する。
Erase state
End Sub② Sheet1を開いた状態で「test_makeMeasuringCupState()」を動かしてみましょう。
３０個の状態が取り得るものとして得られます。
ここでいう「状態１」はスタートの状態です。そして、最終的に目指すゴールの状態は「状態２２」だと言えます。
③ VBAのModule2に次のコードを記載します。同じ状態を繰り返し行き来しないように、一度遷移した状態を記録する工夫が入っています。
Option Explicit
Public Sub MeasuringAlcohol()
' タイトル
Const TITLE As String = "Measuring Alcohol"
' スタート状態番号
Const S_NUM As Long = 1
' ゴール状態番号
Const G_NUM As Long = 22
' 単純なループカウンタ
Dim lp1 As Long, lp2 As Long
Dim i4 As Long, i5 As Long, i9 As Long
' パズルの解析を始めるか問い合わせる。
Dim ret
ret = MsgBox( _
"パズルの解析を始めますか？" _
, vbYesNo + vbQuestion _
, TITLE _
)
' [No]の場合は処理を継続しない。
If ret = vbNo Then
Exit Sub
End If
' お酒の分配方法を配列に作成する。
Dim state() As StateType
state = makeMeasuringCupState
' お酒の分配した状態を保持する作業用変数
Dim wkSitu As StateType
' お酒の分配手順の遷移履歴
Dim history() As StateType
' スタートの状態を決める。
' ※７リットル容器に７リットル入っている状態がスタート
wkSitu = state(S_NUM)
ReDim Preserve history(1) As StateType
history(1) = wkSitu
' 結果件数カウント用変数
Dim ansCnt As Long
ansCnt = 0
' 遷移可能な状態を調べ始める位置を指す。
Dim p As Long
p = 2
' 結果の出力ヘッダを記載する。
Range("A1").Value = "手順"
Range("C1").Value = "状態番号の遷移の様子→"
' スタート状態からゴール状態に遷移可能なすべての状態遷移を探す。
Do While (True)
' 現在の状態から遷移可能な状態を調べる。
For lp1 = p To UBound(state)
' 遷移可能か調べる。
If chkTransition(wkSitu, state(lp1)) = False Then
' この状態へは遷移できない。
GoTo NEXT_SITUATION
End If
' 遷移可能な状態であっても、一度なったことがある状態
' には遷移できない。
If chkHistory(history, state(lp1)) Then
' この状態へは遷移できない。
GoTo NEXT_SITUATION
End If
' ++++++++++++++++++++++++++++++++
' 状態を遷移する。
' ++++++++++++++++++++++++++++++++
' 遷移する状態がゴールの状態であれば、答えが見つかった。
If jdgEqualSituation(state(lp1), state(G_NUM)) Then
' 答えの数をカウントする。
ansCnt = ansCnt + 1
' 答えを書き出す。
With Range("A2").Offset(ansCnt - 1, 0)
.Offset(0, 0).Value = "手順" & ansCnt
For lp2 = 1 To UBound(history)
.Offset(0, 1 + lp2).Value _
= "状態" & getStateNumber(history(lp2), state)
Next lp2
.Offset(0, 1 + lp2).Value = "状態" & G_NUM
End With
' 次の遷移状態を調べる。
GoTo NEXT_SITUATION
End If
' 状態を遷移する。
wkSitu = state(lp1)
' 状態を遷移して、履歴にも登録する。
ReDim Preserve history(UBound(history) + 1) As StateType
history(UBound(history)) = wkSitu
' 新しい状態から、再度遷移可能な状態を調べなおす。
p = 2
GoTo NEXT_VERIFY
NEXT_SITUATION:
Next lp1
' 手詰まり。まだ調べる余地があるか判別する。
If UBound(history) = 1 Then
' これ以上調べる必要なし。
Exit Do
End If
' 手詰まり。ひとつ前の状態に戻して遷移状態を調べなおす。
wkSitu = history(UBound(history) - 1)
p = getStateNumber(history(UBound(history)), state) + 1
ReDim Preserve history(UBound(history) - 1) As StateType
NEXT_VERIFY:
Loop
' 処理の終了を表示する。
MsgBox "手順は" & ansCnt & "パターン見つかりました。" _
, vbInformation _
, TITLE
' メモリを解放する。
Erase state
Erase history
End Sub
' *
' * 履歴を調べて一度でも経過した状態でないか調べるファンクション
' *
Public Function chkHistory( _
pHistory() As StateType _
, pSitu As StateType _
) As Boolean
' 単純なループカウンタ
Dim lp As Long
' お酒の分配手順の遷移履歴を参照して、
' 一度も遷移していない状態であることを確認する。
For lp = 1 To UBound(pHistory)
If pHistory(lp).v4 = pSitu.v4 _
And pHistory(lp).v5 = pSitu.v5 _
And pHistory(lp).v9 = pSitu.v9 Then
' 遷移履歴に同じ状態があった。
chkHistory = True
Exit Function
End If
Next lp
' 遷移履歴に同じ状態がない。
chkHistory = False
End Function
' *
' * 状態1と状態2が等しい状態ではないか調べるファンクション
' *
Public Function jdgEqualSituation( _
pSituation1 As StateType _
, pSituation2 As StateType _
) As Boolean
' 同じ状態であるか判別する。
If pSituation1.v4 = pSituation2.v4 _
And pSituation1.v5 = pSituation2.v5 _
And pSituation1.v9 = pSituation2.v9 Then
' 同じ状態である。
jdgEqualSituation = True
Else
' 違う状態である。
jdgEqualSituation = False
End If
End Function
' *
' * 状態番号を調べるファンクション
' *
Public Function getStateNumber( _
pSituation As StateType _
, pState() As StateType _
) As Long
' 単純なループカウンタ
Dim lp As Long
' 状態番号を調べて返す。
For lp = 1 To UBound(pState)
If jdgEqualSituation(pSituation, pState(lp)) Then
getStateNumber = lp
Exit For
End If
Next lp
End Function
' *
' * 状態Ａから状態Ｂへ遷移可能か調べるファンクション
' *
Public Function chkTransition( _
pStatue_A As StateType _
, pStatue_B As StateType _
) As Boolean
' お酒の量が変化した計量カップが二つであるかどうか調べる。
'※変化していない計量カップが一つであることと同意。
If Not ( _
(pStatue_A.v4 = pStatue_B.v4 _
And pStatue_A.v5 <> pStatue_B.v5 _
And pStatue_A.v9 <> pStatue_B.v9) _
Or (pStatue_A.v4 <> pStatue_B.v4 _
And pStatue_A.v5 = pStatue_B.v5 _
And pStatue_A.v9 <> pStatue_B.v9) _
Or (pStatue_A.v4 <> pStatue_B.v4 _
And pStatue_A.v5 <> pStatue_B.v5 _
And pStatue_A.v9 = pStatue_B.v9)) Then
' 遷移不可能である。
chkTransition = False
Exit Function
End If
' お酒の量が増えた計量カップのサイズを保持する変数
Dim cupSizeInc As Long
' お酒の量が減った計量カップのサイズを保持する変数
Dim cupSizeDic As Long
' お酒の量が増えた計量カップの、その増加分を保持する変数
Dim chkValue1 As Long
' お酒の量が減った計量カップの、その減少分を保持する変数
Dim chkValue2 As Long
' 状態Ａ→状態Ｂの変化において、
' ４リットルの計量カップの変化を調べる。
If pStatue_A.v4 < pStatue_B.v4 Then
cupSizeInc = 4
chkValue1 = pStatue_B.v4
ElseIf pStatue_A.v4 > pStatue_B.v4 Then
cupSizeDic = 4
chkValue2 = pStatue_B.v4
End If
'状態Ａ→状態Ｂの変化において、
' ５リットルの計量カップの変化を調べる。
If pStatue_A.v5 < pStatue_B.v5 Then
cupSizeInc = 5
chkValue1 = pStatue_B.v5
ElseIf pStatue_A.v5 > pStatue_B.v5 Then
cupSizeDic = 5
chkValue2 = pStatue_B.v5
End If
'状態Ａ→状態Ｂの変化において、
' ９リットルの計量カップの変化を調べる。
If pStatue_A.v9 < pStatue_B.v9 Then
cupSizeInc = 9
chkValue1 = pStatue_B.v9
ElseIf pStatue_A.v9 > pStatue_B.v9 Then
cupSizeDic = 9
chkValue2 = pStatue_B.v9
End If
If chkValue1 = cupSizeInc Then
'増えたカップの水量が満杯であれば遷移可能である。
chkTransition = True
ElseIf chkValue2 = 0 Then
'減ったカップの水量がゼロであれば遷移可能である。
chkTransition = True
Else
' 遷移不可能である。
chkTransition = False
End If
End Function④ Sheet2を開いた状態で「MeasuringAlcohol()」を動かしてみましょう。
手順は一つもないようです！
プログラムを使って「不可能」を証明できるのは、なんだかおもしろいですよね。
コメントを残す