パスカルの三角形:ExcelでVBAプログラミング

昨日のエントリで、ExcelでVBAプログラミングする練習をしてみた。

せっかくなので、もう少しなにか面白いものをしてみたい。
ForループとCellの値の参照だけ、という限られた機能で、何か意味のありそうなもの・・・・

というわけで、パスカルの三角形を出力してみることにした。
パスカルの三角形 | Wikipedia

Sub pascals_triangle()
    h = 12
    Cells(1, h).Value = 1
    For r = 2 To h
        For c = h - r + 1 To h + r - 1 Step 2
            i = 0
            If c <> h - r + 1 Then i = i + Cells(r - 1, c - 1).Value
            If c <> h + r - 1 Then i = i + Cells(r - 1, c + 1).Value
            Cells(r, c).Value = i
        Next
    Next
End Sub

実行結果

プログラムコード中の h は三角形の高さを表すので、これを大きな値にすればもっと大きな三角形になる。

パスカルの三角形ができたら、勢いでシェルピンスキーのギャスケットも作ってみたい。
シェルピンスキーのギャスケット | Wikipedia

シェルピンスキーのギャスケットは、パスカルの三角形の値が奇数のところだけ着色すればいい。

セルに着色するには次のようにする。

Cells(行番号, 列番号).Interior.Color = RGB(0255の値, 0255の値, 0255の値)

上記のコードの一部を変更して、次のようにしてみる。

Sub sierpinski_gasket()
    h = 30
    Cells(1, h).Value = 1
    Cells(1, h).Interior.Color = RGB(0, 0, 255)
    For r = 2 To h
        For c = h - r + 1 To h + r - 1 Step 2
            i = 0
            If c <> h - r + 1 Then i = i + Cells(r - 1, c - 1).Value
            If c <> h + r - 1 Then i = i + Cells(r - 1, c + 1).Value
            Cells(r, c).Value = i
            If i Mod 2 <> 0 Then Cells(r, c).Interior.Color = RGB(0, 0, 255)
        Next
    Next
End Sub

できた。

上の例では高さを30にしてみた。

この調子で、値をいくらでも大きくできそうだけど、実際はExcelのLong型で扱える 2,147,483,647 の値を超えてしまうので高さ35の途中でオーバーフローで止まってしまう。

ふむ。

シェルピンスキーのギャスケットは、奇数か偶数かだけわかれば十分なので、実際は値を計算する必要はない。
右上と左上を見て、偶数+偶数=偶数、奇数+奇数=偶数、偶数+奇数=奇数、という判定だけすれば十分。

というわけで、下のようにすれば、いくらでも大きな図形を作り出すことができる。

Sub sierpinski_gasket()
    h = 100
    Cells(1, h).Value = 1
    Cells(1, h).Interior.Color = RGB(0, 0, 255)
    For r = 2 To h
        For c = h - r + 1 To h + r - 1 Step 2
            i = 0
            If c <> h - r + 1 Then i = i + Cells(r - 1, c - 1).Value
            If c <> h + r - 1 Then i = i + Cells(r - 1, c + 1).Value
            Cells(r, c).Value = i Mod 2
            If i <> 0 Then Cells(r, c).Interior.Color = RGB(0, 0, 255)
        Next
    Next
End Sub

できた!


フラクタル

フラクタル

フラクタル幾何学(上) (ちくま学芸文庫)

フラクタル幾何学(上) (ちくま学芸文庫)