ドラゴン曲線（Mathematicaショートフラクタルシリーズ）

今回のテーマ

Mathematicaショートフラクタルシリーズ、第4回は、僕が一番好きなフラクタル図形、ドラゴン曲線（ヘイウェイ・ドラゴン）です。

ほぼ完成形

dragon_normal.nb

Graphics[Line[
  {Re[#], Im[#]} & /@
  Join[
    {0}, 
    Accumulate[(-1)^(Nest[Join[# + 1, Reverse[#] - 1] &, {0}, 11]/4)]
  ]
]]

@butchi_y (More info: https://t.co/HBUuaZOB3w) #wolframlang pic.twitter.com/l58URrO4HJ

— Tweet-a-Program (@wolframtap) 2015, 12月 17

原理

昨日のコッホ曲線の記事で紹介した「偏角関数」を今回も使います。

ドラゴン曲線の偏角が45度の何倍になるか
（nが偶数の時は0,2,4,8…の組み合わせ、nが奇数の時は1,3,5,7…の組み合わせ）のリストを

Join[# + 1, Reverse@# - 1] &

で求め、それを初期値{0}で$n$回ネストしています。
偏角のリストは以下のように増えていきます。

第0段階 {0}
第1段階 {1,-1}
(=Join[{0}+1,{0}-1])
第2段階 {2,0,-2,0}
(=Join[{1,-1}+1,{-1,1}-1])
第3段階 {3,1,-1,1,-1,-3,-1,1}
(=Join[{2,0,-2,0}+1,{0,-2,0,2}-1])
第4段階 {4,2,0,2,0,-2,0,2,0,-2,-4,-2,0,-2,0,2}
(=Join[{3,1,-1,1,-1,-3,-1,1}+1,{1,-1,-3,-1,1,-1,1,3}-1])
…

偏角リストを見ながら法則性を探して試行錯誤しながらプログラムを書いていたのですが、Reverseを使うのは閃きでした。

ショートコード化

コッホ曲線のとき同様、

• AccumulateとJoinを併用するよりPlusをFoldListした方が端的

というぐらいで、ほとんど変わりませんが、
これで83文字のプログラムができました。

dragon_short.nb

Graphics@Line[{Re[#],Im[#]}&/@FoldList[Plus,0,I^Nest[Join[#,Reverse@#+1]&,{0},14]]]

@butchi_y (More info: https://t.co/HBUuaZOB3w) #wolframlang pic.twitter.com/GQiB0bYXX4

— Tweet-a-Program (@wolframtap) 2015, 12月 17

Rosetta Codeに載っているMathematicaコードよりも短く、
他の言語と比較してもかなり短いです。

予告

明日は、ドラゴン曲線を重ねただけではありながら趣深いツインドラゴンです。