はじめに
カレンダーの穴が空いてしまったので、
Mathematicaショートフラクタルシリーズを1日限定で復活というか継続します。
今回のテーマ
第6回はフィボナッチ列フラクタル。
フィボナッチ列自体マイナーなのですが、それを使ったフラクタル図形で、比較的最近発見されたものなので、文献も少ないです。
ということで、本シリーズのスタメンからは外したのですが、僕自身も研究が浅いながら奥深いのでご紹介します。
さっき見つけたばかりでまだちゃんと読んでませんが、こちらにもMathematicaでの実装が見られます。
HULINKS | Mathematica ジャーナル | フィボナッチ列フラクタルの性質および一般化
ほぼ完成形
fibonacci_word_fractal.nb
w = Flatten[Nest[{#, #[[1]]} &, {1, 0}, 20]];
ListPlot[{Re[#], Im[#]} & /@
Accumulate[
Join[
{0},
I^Accumulate[Join[{1}, w*(-1)^Mod[Range[Length[w]], 2]]]
]
],
Joined -> True,
AspectRatio -> Automatic
]
生成過程
In[1] := w = Flatten[Nest[{#, #[[1]]} &, {1, 0}, 5]];
Out[1] := {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1}
これでフィボナッチ列が得られます。
オンライン整数列大辞典のフィボナッチ列のページにも同様のMathematicaコードを載せましたが、僕が実装したこのショートコードが功を奏しています。
フィボナッチ列フラクタルのルール（奇数偶数描画規則と呼ぶらしい）をアレンジした
- 0なら直進
- 1で偶数番目なら右折
- 1で奇数番目なら左折
を適用させ、曲がるルール（→偏角）を取得します。
In[2] := Accumulate[Join[{1}, w*(-1)^Mod[Range[Length[w]], 2]]]
Out[2] := {1, 0, 0, -1, 0, 0, 1, 1, 2, 1, 1, 0, 1, 1, 2, 2, 3, 2, 2, 1, 1, 0}
これを $\frac\pi2$ 倍したのが偏角リストです。
あとは以下のリストをさらにAccumulateすれば点列が得られます。
In[3] := I^Accumulate[Join[{1}, w*(-1)^Mod[Range[Length[w]], 2]]]
Out[3] := {I, 1, 1, -I, 1, 1, I, I, -1, I, I, 1, I, I, -1, -1, -I, -1, -1, I, I,
1}
ショートコード化
- ワンライナー化
-
AccumulateはFoldListに - 点列の個数はマジックナンバー（
Fibonacci[23] == 28657）に - Modなしでも問題なかったので外した
で、121文字の以下のショートコードができました。
fibonacci_word_fractal_short.nb
Graphics[Line[{Re[#],Im[#]}&/@FoldList[Plus,0,I^FoldList[Plus,1,Flatten[Nest[{#,#[[1]]}&,{1,0},20]]*(-1)^Range[28657]]]]]
@butchi_y (More info: https://t.co/HBUuaZOB3w) #wolframlang pic.twitter.com/0WibHKECC2
— Tweet-a-Program (@wolframtap) 2015, 12月 20
明日は
後出しですが、明日はかなりすごいMathematica使いのDyunamisさんです。