t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

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

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

プログラマ脳を鍛える数学パズル シンプルで高速なコードが書けるようになる70問

プログラマ脳を鍛える数学パズル シンプルで高速なコードが書けるようになる70問

これはプログラムコードを書いてパズルを解こうという趣旨の本。
解説部分はRubyJavaScriptであるが、ぱっと見たところ問題は特に言語に特化したものではないので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に特化したパズル本もある。

Excel VBAでパズルを解こう

Excel VBAでパズルを解こう

こっちは9問しかなかったけれど、これはこれで面白かった。
ただVBA本のほうはちょっと初っ端から難易度が高いので、今回紹介したような易しめの問題なら「プログラマ脳を鍛える数学パズル」がおススメ。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。