VBAで「プログラマ脳を鍛える数学パズル」にチャレンジ

以前から気になっていた書籍「プログラマ脳を鍛える数学パズル」を買ってきた。

作者: 増井敏克
出版社/メーカー: 翔泳社
発売日: 2015/10/14
メディア: 単行本（ソフトカバー）
この商品を含むブログ (10件) を見る

これはプログラムコードを書いてパズルを解こうという趣旨の本。
解説部分はRubyとJavaScriptであるが、ぱっと見たところ問題は特に言語に特化したものではないのでVBAでも多分解ける。
まだ1問目を解いたところなので何とも言えないけれど。

さて、1問目は十進数、二進数、八進数であらわしたとき、すべて回文になる10以上の最小値を求めよというもの。
回文というのは、上から読んでも下から読んでも同じになる言葉のこと。「トマト」とかそういうやつのことです。

十進数では、11、22、33とか、101、1001、21012とか、こんな感じ。
二進数で10以上ということで、1111、10001など。
八進数というのはあまり馴染みがないかもしれないが、0～7の数字を利用して8で繰り上がる数。

これは簡単。
総当たりで回文かどうか確かめながら十進、二進、八進でそれぞれ回文チェックして、3つともクリアしたらループ終了すればいい。

まずは十進を二進、八進に変換する手段だけど、確かワークシート関数にあったなと思って次のようなコードを書いた。

Sub Q1()
    Dim found As Boolean
    Dim n As Long
    n = 9
    Dim binString As String, decString As String, octString As String
    Do Until found
        n = n + 1
        With WorksheetFunction
            binString = CStr(.Dec2Bin(n))
            decString = CStr(n)
            octString = CStr(.Dec2Oct(n))
        End With
        found = _
            binString = ReverseString(binString) And _
            decString = ReverseString(decString) And _
            octString = ReverseString(octString)
    Loop
    Debug.Print n
End Sub

Function ReverseString(str As String) As String
    Dim ret As String
    For i = Len(str) To 1 Step -1
        ret = ret & Mid(str, i, 1)
    Next
    ReverseString = ret
End Function

ところが「WorksheetFunction クラスの Dec2Bin プロパティを取得できません。」とエラーが発生。
f:id:t-hom:20161020102449p:plain

デバッグしてみると、エラー発生時、変数nの値は512。
あちゃー。。もしかしてワークシート関数のDec2Binって511が限界なのか。。2バイト。ショボっ！
このあたり、VBAならではの苦労である。他の言語はもっと簡単に二進数変換できる。

仕方ない、作るか。。

…出来たのがこちらの二進文字列作成関数
アルゴリズムは簡単で、2で割りながら余りをくっつけていくだけ。
専門学校で習った基数変換のやり方だ。

Function DecToBin(ByVal n As Long) As String
    Dim ret As String
    Do While n > 0
        ret = n Mod 2 & ret
        n = n \ 2
    Loop
    DecToBin = ret
End Function

ちなみにオブジェクトブラウザを眺めていたらStrReverseなんて関数を発見。
f:id:t-hom:20161020103332p:plain
そっちはあるのか。。

あと八進変換と十六進変換はVBA関数でふつうにOct関数、Hex関数がある。
さっきのエラーでWorksheetFunctionの基数変換に不信感をもった私はVBA関数のOctを使うことにした。

そして最終的にコードはこうなった。

Sub Q1()
    Dim found As Boolean
    Dim n As Long
    n = 9
    Dim binString As String, decString As String, octString As String
    Do Until found
        n = n + 1
        binString = CStr(DecToBin(n))
        decString = CStr(n)
        octString = CStr(Oct(n))
        found = _
            binString = StrReverse(binString) And _
            decString = StrReverse(decString) And _
            octString = StrReverse(octString)
    Loop
    Debug.Print n
End Sub

Function DecToBin(ByVal n As Long) As String
    Dim ret As String
    Do While n > 0
        ret = n Mod 2 & ret
        n = n \ 2
    Loop
    DecToBin = ret
End Function

結果は585と出た。
ちゃんと二進と八進でも回文になっている。
f:id:t-hom:20161020103612p:plain

でもまだちょっとコードが汚い。
それで色々整理した結果、こうなった。

Sub Q1()
    Dim n As Long: n = 10
    Do
        If 回文(n) And 回文(DecToBin(n)) And 回文(Oct(n)) Then
            Debug.Print n
            Exit Do
        End If
        n = n + 1
    Loop
End Sub

Function 回文(str As Variant) As Boolean
    回文 = CStr(str) = StrReverse(CStr(str))
End Function

Function DecToBin(ByVal n As Long) As String
    Dim ret As String
    Do While n > 0
        ret = n Mod 2 & ret
        n = n \ 2
    Loop
    DecToBin = ret
End Function

こちらもちゃんと動く。
同じ問題を解くにしても、よりシンプルで美しいコードを考える作業は楽しい。
(私のコードが良くなったと思うかどうかは主観的なものなので、人それぞれでしょうけど。)

ちなみにRubyだと数値も文字列もオブジェクトなので、「num.to_s(8).reverse」のようにメソッドを繋げていくだけで8進数の逆さ文字列を得られる。
このあたり、VBAはけっこう面倒くさい言語なんだけれど、その面倒くささに慣れてしまうとそれが普通になってしまう。
「これが普通だ」と思うと、それ以上工夫しなくなる。

他の言語を見ていると、なるほど、こんな書き方ができるのかと気づきを得られる。
無いものは作ればいいけど、知らないものは作れない。
だから、他の言語にも興味のある方はチャレンジしてみると良いと思う。
結局VBAしか使わなくても、そこで得た気づきは無駄にはならない。

さて、70問あるので、しばらく遊べそうだ。

ちなみにVBAに特化したパズル本もある。