Excelのマクロでコッホ曲線を描いてみた

あなたは、コッホ曲線をご存知でしょうか?
ここでは、フラクタルの1種であるコッホ曲線を描いてみようと思います。

コッホ曲線

コッホ曲線を描くのは簡単です。

コッホ曲線の要素

コッホ曲線の要素

  • 直線を1本引きます
  • それを3等分します
  • 真ん中の3等分線を1辺とした正三角形を描きます
  • もともとの真ん中の3等分線を消します
  • 新たにできた4つの線分について同様の処理を繰り返します

Excelでコッホ曲線を描いてみよう

Excelのマクロは次のようになります。
マクロの使い方が分からない方は、こちらの記事からお読みください。

Option Explicit

' フラクタルを構成する座標を求める再帰手続き
' dblX1   : 始点のX座標
' dblY1   : 始点のY座標
' dblX2   : 終点のX座標
' dblY2   : 終点のY座標
' intLevel: フラクタルのレベル
Public Sub f( _
        ByVal dblX1 As Double, _
        ByVal dblY1 As Double, _
        ByVal dblX2 As Double, _
        ByVal dblY2 As Double, _
        ByVal intLevel As Integer)
    Dim dblNewX     As Double   ' 縮小した線分をθ回転させたときのX方向の長さ
    Dim dblNewY     As Double   ' 縮小した線分をθ回転させたときのY方向の長さ
    Dim dblRatio    As Double   ' 縮小率
    Dim dblTheta    As Double   ' 線分を回転させる角度θ
    Dim dblX        As Double   ' 縮小した線分のX方向の長さ
    Dim dblY        As Double   ' 縮小した線分のY方向の長さ
    Dim lngRow      As Long     ' 座標を書き込む行番号
    
    ' 座標を書き込む行番号を求める(記載済みの次の行番号)
    lngRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    ' 線分の縮小率(0.333…)
    dblRatio = 1 / 3#
    ' 角度(60°)をラジアンにする
    dblTheta = 60 * WorksheetFunction.Pi() / 180
    ' 始点と終点の座標の差を取り、縮小率をかけてX,Y方向の長さを求める
    dblX = (dblX2 - dblX1) * dblRatio
    dblY = (dblY2 - dblY1) * dblRatio
    ' 縮小した線分を回転させる
    dblNewX = Cos(dblTheta) * dblX - Sin(dblTheta) * dblY
    dblNewY = Sin(dblTheta) * dblX + Cos(dblTheta) * dblY
    ' レベルによって分岐
    If intLevel > 0 Then
        ' レベルが0でなければ1つ下げる
        intLevel = intLevel - 1
        ' 辺ごとの座標を設定して再帰呼び出し
        Call f(dblX1, dblY1, dblX1 + dblX, dblY1 + dblY, intLevel)
        Call f(dblX1 + dblX, dblY1 + dblY, dblX1 + dblX + dblNewX, dblY1 + dblY + dblNewY, intLevel)
        Call f(dblX1 + dblX + dblNewX, dblY1 + dblY + dblNewY, dblX2 - dblX, dblY2 - dblY, intLevel)
        Call f(dblX2 - dblX, dblY2 - dblY, dblX2, dblY2, intLevel)
    Else
        ' 辺ごとの座標をシートに描きこむ。2度書きしないように終点を除く
        Range("A" & lngRow).Value = dblX1
        Range("B" & lngRow).Value = dblY1
        Range("A" & lngRow + 1).Value = dblX1 + dblX
        Range("B" & lngRow + 1).Value = dblY1 + dblY
        Range("A" & lngRow + 2).Value = dblX1 + dblX + dblNewX
        Range("B" & lngRow + 2).Value = dblY1 + dblY + dblNewY
        Range("A" & lngRow + 3).Value = dblX2 - dblX
        Range("B" & lngRow + 3).Value = dblY2 - dblY
    End If
End Sub

' フラクタルな図形を描くための座標を求めます
Public Sub Fractal()
    Const cstX1     As Double = 0   ' 始点のX座標
    Const cstX2     As Double = 1   ' 終点のX座標
    Const cstY1     As Double = 0   ' 始点のY座標
    Const cstY2     As Double = 0   ' 終点のY座標
    Const cstLevel  As Integer = 4  ' フラクタルのレベル
    Dim lngRow      As Long         ' 座標を書き込む行番号
    
    ' 座標を書き込む列をクリア
    Range("A:B").Clear
    ' 1行目にXとYのタイトルを表示
    Range("A1").Value = "X"
    Range("B1").Value = "Y"
    ' フラクタルの座標を求める関数を呼び出す
    Call f(cstX1, cstY1, cstX2, cstY2, cstLevel)
    ' 終点座標を書き込む行番号を取得
    lngRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    ' 終点の座標を書き込む
    Range("A" & lngRow).Value = cstX2
    Range("B" & lngRow).Value = cstY2
End Sub

Fractalを実行すると、A、B列に座標が計算されます。

これをグラフ化してみて下さい。

コッホ曲線

コッホ曲線

cstLevelの数を小さくすると単純な図形になり、数を増やすと複雑な図形になります。

Const cstLevel As Integer = 6 ‘ フラクタルのレベル

7にしてしまうと行数が65538行になり、グラフ表示できなくなるので、6までにして下さい。

前節で説明したコッホ曲線の描き方はサブルーチンのfで実現されています。このfの内容を変えるとコッホ曲線とは異なる曲線になります。

そんなに難しくはないと思いますので、いろいろと試してみて下さい。

コッホ曲線を変形したら変な曲線になった

僕は、レベル毎に凹凸の方向が逆になった場合に、どのような図形になるか試してみました。

この改造は簡単で、

dblTheta = 60 * WorksheetFunction.Pi() / 180

とある行を

dblTheta = (-1) ^ intLevel * (60 * WorksheetFunction.Pi() / 180)

と直せば終わりです。

結果はこのようになりました。

化学の構造式みたいな曲線

化学の構造式みたいな曲線

何か、化学の構造式みたい。

これもフラクタルと言えるのでしょうか?

まとめ

優れたデザインが、単純なパターンの繰り返しである例は沢山あります。

このマクロを使って、いろいろなフラクタルを描いているうち、思わぬ優れたデザインに出会えるかもしれません。

コメント

タイトルとURLをコピーしました