『覆面算』とは、記号で表された数式の空欄に、0～9の数字を当てはめて完成させるパズルです。推理しながら正しい計算式を導きます。
大事なルール：違うアルファベットには違う数字、同じアルファベットには同じ数字を入れる。
「BASE ＋ BALL ＝ GAMES」は、７種類のアルファベット {A, B, E, G, L, M, S} で構成された文字です。これらのアルファベット に、便宜上インデックス（番号）を割り振ります。ただし、ここで付ける番号はアルファベット に対応する数値ではなく、識別のためのインデックスです。混同を避けるため、インデックスは括弧書きで表記します。
こういうことです。
次の等式が成立するものを力技で探します。
(2)×1000 ＋ (1)×100 ＋ (7)×10 ＋ (3)×10
＋ (2)×1000 ＋ (1)×100 ＋ (5)×10 ＋ (5)×10
＝ (4)×10000 ＋ (1)×1000 ＋ (6)×100 ＋ (3)×10 ＋ (7)×10① VBAのModule1に次のコードを記載します。
Option Explicit
Public Sub BaseBallGames()
' タイトル
Const TITLE As String = "Base Ball Games"
' 単純なループカウンタ
Dim lp1 As Long, lp2 As Long
Const P As Long = 10 ' 要素数
Const N As Long = 7 ' 選択できる数
' 答えの数をカウントする変数
Dim ansCnt As Long
' パズルの解析を始めるか問い合わせる。
Dim ret
ret = MsgBox( _
"パズルの解析を始めますか？" _
, vbYesNo + vbQuestion _
, TITLE _
)
' [No]の場合は処理を継続しない。
If ret = vbNo Then
Exit Sub
End If
' １～１０の順列を作成する。
Dim permArray() As Integer
permArray = makePermutation(P, N)
' 連想配列を作成する。
Dim hs As Object
Set hs = CreateObject("Scripting.Dictionary")
hs.Add 1, 1
hs.Add 2, 2
hs.Add 3, 3
hs.Add 4, 4
hs.Add 5, 5
hs.Add 6, 6
hs.Add 7, 7
hs.Add 8, 8
hs.Add 9, 9
hs.Add 10, 0 ' ※１０→０
' 作成した順列の内容を書き換える。
For lp1 = 1 To UBound(permArray, 1)
For lp2 = 1 To UBound(permArray, 2)
' 連想配列を使って書き換える。
permArray(lp1, lp2) _
= hs.Item(permArray(lp1, lp2))
Next lp2
Next lp1
' 作った配列を一つずつ検証する。
For lp1 = 1 To UBound(permArray, 1)
' 作業用配列を作る。
Dim wk() As Long
ReDim wk(UBound(permArray, 2)) As Long
For lp2 = 1 To UBound(permArray, 2)
wk(lp2) = permArray(lp1, lp2)
Next lp2
' "BASE"を作る。
Dim base As Long
base = wk(2) * 1000 _
+ wk(1) * 100 _
+ wk(7) * 10 _
+ wk(3)
' "BALL"を作る。
Dim ball As Long
ball = wk(2) * 1000 _
+ wk(1) * 100 _
+ wk(5) * 10 _
+ wk(5)
' "GAMES"を作る。
Dim games As Long
games = wk(4) * 10000 _
+ wk(1) * 1000 _
+ wk(6) * 100 _
+ wk(3) * 10 _
+ wk(7)
' 条件Aを検証する。
If base + ball = games _
And wk(2) > 0 _
And wk(4) > 0 Then
' 見つかった答えを書き出す。
With Range("A1")
.Cells(ansCnt * 4 + 1, 3).Value = wk(2)
.Cells(ansCnt * 4 + 1, 4).Value = wk(1)
.Cells(ansCnt * 4 + 1, 5).Value = wk(7)
.Cells(ansCnt * 4 + 1, 6).Value = wk(3)
.Cells(ansCnt * 4 + 2, 1).Value = "＋"
.Cells(ansCnt * 4 + 2, 3).Value = wk(2)
.Cells(ansCnt * 4 + 2, 4).Value = wk(1)
.Cells(ansCnt * 4 + 2, 5).Value = wk(5)
.Cells(ansCnt * 4 + 2, 6).Value = wk(5)
.Cells(ansCnt * 4 + 3, 2).Value = wk(4)
.Cells(ansCnt * 4 + 3, 3).Value = wk(1)
.Cells(ansCnt * 4 + 3, 4).Value = wk(6)
.Cells(ansCnt * 4 + 3, 5).Value = wk(3)
.Cells(ansCnt * 4 + 3, 6).Value = wk(7)
End With
' 枠線の描画を行う。
Range("A1:F1").Offset(ansCnt * 4 + 1, 0) _
.Borders(xlEdgeBottom).LineStyle = xlContinuous
' 答えの数をカウントする。
ansCnt = ansCnt + 1
End If
' メモリを解放する。
Erase wk
Next lp1
' 答えが見つかったかどうか判別する。
If ansCnt = 0 Then
MsgBox "答えは見つかりませんでした。" _
, vbExclamation _
, TITLE
Else
MsgBox "答えは" & ansCnt & "件見つかりました。" _
, vbInformation _
, TITLE
End If
' メモリを解放する。
Erase permArray
' オブジェクトを解放する。
Set hs = Nothing
End Sub
Public Function makePermutation( _
N As Long _
, r As Long _
) As Integer()
' 単純なループカウンタ
Dim lp1 As Long, lp2 As Long, lp3 As Long, lp4 As Long
' 順列数特定用変数
Dim caseCnt As Long
' 戻り値作成用変数
Dim ret() As Integer
' 順列数を特定する。
caseCnt = 1
For lp1 = N To (N - r + 1) Step -1
caseCnt = caseCnt * lp1
Next lp1
' 戻り値配列を作成する。
ReDim ret(caseCnt, r) As Integer
' 作成済みの順列の数を保持する変数
Dim pos As Long
pos = 1
' 作成中の順列の数を保持する変数
Dim wkPos As Long
wkPos = 1
' 順列の最初の一つを作成する。
For lp1 = 1 To r
ret(pos, lp1) = lp1
Next lp1
' 二番目に大きな値から順に処理する。
For lp1 = N - 1 To 1 Step -1
' "一つ大きな値"～"一番大きな値"まで順に処理する。
For lp2 = lp1 + 1 To N
' 作成済みの順列を一つずつ処理する。
For lp3 = 1 To pos
' 作成中の順列の数を一つ増やす。
wkPos = wkPos + 1
' 一度でも入れ替え処理を行ったか判別するための
' フラグをFalseで初期化する。
Dim flg As Boolean
flg = False
' lp2とlp1が指す値の入れ替え処理を行う。
For lp4 = 1 To r
If ret(lp3, lp4) = lp1 Then
ret(wkPos, lp4) = lp2
flg = True
ElseIf ret(lp3, lp4) = lp2 Then
ret(wkPos, lp4) = lp1
flg = True
Else
ret(wkPos, lp4) = ret(lp3, lp4)
End If
Next lp4
' 一度でも入れ替え処理を行ったか判別する。
If flg = False Then
' 今作った順列を削除する。
wkPos = wkPos - 1
End If
Next lp3
Next lp2
' 作成済みの順列の数を更新する。
pos = wkPos
Next lp1
' 作成した順列を呼び出し元に返す。
makePermutation = ret
End Function
② Sheet1を開いた状態でBaseBallGames() を動かしてみましょう。
見つかった答えは1つだけでした。
回答はこれです！
コメントを残す