あなたは、コッホ曲線をご存知でしょうか?
ここでは、フラクタルの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)
と直せば終わりです。
結果はこのようになりました。
何か、化学の構造式みたい。
これもフラクタルと言えるのでしょうか?
まとめ
優れたデザインが、単純なパターンの繰り返しである例は沢山あります。
このマクロを使って、いろいろなフラクタルを描いているうち、思わぬ優れたデザインに出会えるかもしれません。
コメント