パズルを解く

コンピュータ VBA

えー、こりもせず頭の悪いプログラムを公開してみます。


半年くらい前の話ですが、下のようなパズルを見かけました。

各アルファベットに当てはまる数字を答えなさい。
但し、各文字と数字は1対1に対応する。

   ADAM
    AND
    EVE
     ON
(+)   A

    

  • 

      

    • 

        

      • 

          

        • 

            

          • 

              

            • -
              • 

            • 

          • 

        • 

      • 

    • 

   RAFT


数学トリック=だまされまいぞ!―数学発想クイズ (ブルーバックス)

こういうものの著作権ってどうなっているのか分からないので、とりあえず出典を明記しておきます。
難しい専門書*1というわけでもない、わりと雑学レベルに近い話題が書いてある本です。*2


最初は手当たり次第に数字を当てはめて解こうとしました。
Excelの関数を使って、正解だったら"OK"と出るようにしたりとかいろいろ工夫して。
ですが、この方法では全く解けませんでした。


で、頭にきて書いたのがこの↓プログラムです。
例によってExcelのマクロ。
Visual Basic Editorに貼り付けて実行すれば動きます。

Option Explicit

Sub Test_S()

 Application.ScreenUpdating = False

 '準備
 Cells.Select
 Selection.ClearContents

 Range("A1").Select
 ActiveCell.Value = "A"
 ActiveCell.Offset(0, 1).Value = "D"
 ActiveCell.Offset(0, 2).Value = "E"
 ActiveCell.Offset(0, 3).Value = "F"
 ActiveCell.Offset(0, 4).Value = "M"
 ActiveCell.Offset(0, 5).Value = "N"
 ActiveCell.Offset(0, 6).Value = "O"
 ActiveCell.Offset(0, 7).Value = "R"
 ActiveCell.Offset(0, 8).Value = "T"
 ActiveCell.Offset(0, 9).Value = "V"
 ActiveCell.Offset(0, 11).Value = "ADAM"
 ActiveCell.Offset(0, 12).Value = "AND"
 ActiveCell.Offset(0, 13).Value = "EVE"
 ActiveCell.Offset(0, 14).Value = "ON"
 ActiveCell.Offset(0, 15).Value = "A"
 ActiveCell.Offset(0, 16).Value = "RAFT"

 '計算
 Range("A2").Select
 
 Dim A As Long
 Dim D As Long
 Dim E As Long
 Dim F As Long
 Dim M As Long
 Dim N As Long
 Dim O As Long
 Dim R As Long
 Dim T As Long
 Dim V As Long
 Dim lngFirst As Long
 Dim lngSecond As Long
 Dim lngThird As Long
 Dim lngFourth As Long
 Dim lngFifth As Long
 Dim lngResult As Long

 For A = 0 To 9
  For D = 0 To 9
   If D = A Then GoTo EndD

   For E = 0 To 9
    If E = A Then GoTo EndE
    If E = D Then GoTo EndE

    For F = 0 To 9
     If F = A Then GoTo EndF
     If F = D Then GoTo EndF
     If F = E Then GoTo EndF

     For M = 0 To 9
      If M = A Then GoTo EndM
      If M = D Then GoTo EndM
      If M = E Then GoTo EndM
      If M = F Then GoTo EndM

      For N = 0 To 9
       If N = A Then GoTo EndN
       If N = D Then GoTo EndN
       If N = E Then GoTo EndN
       If N = F Then GoTo EndN
       If N = M Then GoTo EndN

       For O = 0 To 9
        If O = A Then GoTo EndO
        If O = D Then GoTo EndO
        If O = E Then GoTo EndO
        If O = F Then GoTo EndO
        If O = M Then GoTo EndO
        If O = N Then GoTo EndO

        For R = 0 To 9
         If R = A Then GoTo EndR
         If R = D Then GoTo EndR
         If R = E Then GoTo EndR
         If R = F Then GoTo EndR
         If R = M Then GoTo EndR
         If R = N Then GoTo EndR
         If R = O Then GoTo EndR

         For T = 0 To 9
          If T = A Then GoTo EndT
          If T = D Then GoTo EndT
          If T = E Then GoTo EndT
          If T = F Then GoTo EndT
          If T = M Then GoTo EndT
          If T = N Then GoTo EndT
          If T = O Then GoTo EndT
          If T = R Then GoTo EndT

          For V = 0 To 9
           If V = A Then GoTo EndV
           If V = D Then GoTo EndV
           If V = E Then GoTo EndV
           If V = F Then GoTo EndV
           If V = M Then GoTo EndV
           If V = N Then GoTo EndV
           If V = O Then GoTo EndV
           If V = R Then GoTo EndV
           If V = T Then GoTo EndV

           lngFirst = 1000 * A + 100 * D + 10 * A + M
           lngSecond = 100 * A + 10 * N + D
           lngThird = 100 * E + 10 * V + E
           lngFourth = 10 * O + N
           lngFifth = A
           lngResult = 1000 * R + 100 * A + 10 * F + T

           If lngFirst + _
              lngSecond + _
              lngThird + _
              lngFourth + _
              lngFifth = lngResult Then
            ActiveCell.Value = A
            ActiveCell.Offset(0, 1).Value = D
            ActiveCell.Offset(0, 2).Value = E
            ActiveCell.Offset(0, 3).Value = F
            ActiveCell.Offset(0, 4).Value = M
            ActiveCell.Offset(0, 5).Value = N
            ActiveCell.Offset(0, 6).Value = O
            ActiveCell.Offset(0, 7).Value = R
            ActiveCell.Offset(0, 8).Value = T
            ActiveCell.Offset(0, 9).Value = V

            ActiveCell.Offset(0, 11).Value = lngFirst
            ActiveCell.Offset(0, 12).Value = lngSecond
            ActiveCell.Offset(0, 13).Value = lngThird
            ActiveCell.Offset(0, 14).Value = lngFourth
            ActiveCell.Offset(0, 15).Value = lngFifth
            ActiveCell.Offset(0, 16).Value = lngResult

            ActiveCell.Offset(1, 0).Select
           End If
EndV:
          Next 'V
EndT:
         Next 'T
EndR:
        Next 'R
EndO:
       Next 'O
EndN:
      Next 'N
EndM:
     Next 'M
EndF:
    Next 'F
EndE:
   Next 'E
EndD:
  Next 'D
 Next 'A

 Application.ScreenUpdating = True

End Sub

要はガリガリと総当りで計算させているだけですw
で、これを動かして思ったこと。


これ、コンピュータを使わずに解いた人はいるのか？


解答としてありうる数字の組合せは10!=3628800通りあるわけです。
そして実際の解答は348通り。
つまり、手当たり次第に数字を当てはめて正解となる確率は1/10000未満ということになります。
しかもコンピュータを使わない場合、1つの組合せを計算するのにも多少時間がかかります。


無理だろう…。
最初に私がやったように、補助的にコンピュータを使ったとしても10000通り試すのはかなりの手間です。
そりゃ、偶然に正しい組合せを見つけられた人はいるかもしれないけど…。
更に言えば、それだって解答のうちの1つにしか過ぎないわけですよ。
おそらく"全ての"正しい組合せを見つけるためには、私がやったように総当りで試すしかないと思うのです。
そういう問題を、テーマがコンピュータでもアルゴリズムでもない本で出すのってどうなのよ?


ただ、これは私が思いつけなかっただけで、もしかしたら効率的な探し方があるのかもしれませんけど。
"全ての正しい組合せ"ではなくても、"正しい組合せの1つ"を探すアルゴリズムをご存知の方がいたら教えてください。
ヒントだけでも良いです。


あと、会社のPCだとこれくらいの処理は10秒程度で終わります。
10!くらいの組合せって簡単に試せちゃうんだなぁ、と改めて思いました。


追記：
このエントリを書くためにちょっとその本を見返してみたら、答えは9通りしかないそうです。
何か根本的に勘違いしているのかもしれないw
もしそうだったら恥ずかしいので、そのうちこのエントリは消すかも。

更に追記：
考えてみたら、コンピュータを使わずに総当りで解くのが難しいってのは、こんなプログラムを書かずとも明らかですねw
ってことは、やっぱり総当りじゃない方法があるのか…。

*1:そんな本は読めないw

*2:ちなみに最後まで読みきってません。結構長い期間、読みかけのままですw