はじめに
予定していたMathematicaショートフラクタルシリーズは、予定としては一旦締めです。
今回のテーマ
第5回はツインドラゴン。
ヘイウェイ・ドラゴンを点対称に2つ重ねた図形、なので、描くこと自体は
ヘイウェイ・ドラゴンの幾何学操作で可能です。
しかしツインドラゴンは$1 + i$進法と密接な関係があるので、ツインドラゴンに適した構成法はドラゴン曲線の回とはちょっと異なります。だから好きなのです。
原理
、の前に、前置き
個人的な都合なのですが、来週には数学関係の3つのAdvent Calendarが控えていて、ネタが未確定なので、本記事の補足をいずれかのカレンダーで別途設けようかと思っています。
Math Advent Calendar 2015 - Adventar
数学 Advent Calendar 2015 - Qiita
日曜数学 Advent Calendar 2015 - Adventar
本記事ですっ飛ばしすぎてわからなかった場合は、来週に予定している記事をお待ち下さい。
(2015-12-23追記)補足記事はこちらです。
1+i進数
これだけ触れておきます。
ツインドラゴンは$2$進数の基数を$2$ではなく$1+i$($i$は虚数単位)として
計算することによって現れる図形です。
たとえば、$10$進数の$13$は$2$進数では$1101$と表せますが、
これは$1\times 2^3 + 1\times 2^2 + 0\times 2^1 + 1\times 2^0$と1桁毎に計算することにより
元の$13$という数を得ることができます。
ここで上記の基数$2$を$1+i$に置き換えると
$ 1×(1+i)^3 + 1×(1+i)^2 + 0×(1+i)^1 + 1×(1+i)^0$
$=1×(-2+2i) + 1×(2i) + 0×(1+i) + 1×(1)$
$=-1+4i$
となります。これが複素平面での座標$(-1,4)$になります。
上図は基数変換した座標に2進数の数値を割り当てた、$0$がある座標を原点とした複素平面です。
$13$を上図で探してみると、"0"がある位置から左に$-1$、上に$4$のところにありますよね。
このように、数字を$0$から順番に$1+i$を基数として数えることにより
上図のような数の平面ができます。
ツインドラゴンはTeX(本Qiita記事でも数式表示に使ってます)の創始者D. Knuth氏が$-1+i$進数として世に知らしめた図形です。
本稿では$-1+i$進数ではなく$1+i$進数として考えています。
基数変換による方法
Mathematicaで簡潔に書くと以下のようなコードになります。現時点で96文字です。
Graphics[Point[
Transpose[{Re[#], Im[#]} &[
Table[FromDigits[IntegerDigits[k, 2], 1 + I], {k, 0, 1023}]
]]
]]
@butchi_y (More info: https://t.co/HBUuaZOB3w) #wolframlang pic.twitter.com/4RczdpaSzr
— Tweet-a-Program (@wolframtap) 2015, 12月 17
IntegerDigits
で数を2進数の桁のリストに変換し、それをFromDigits
で$1+i$を基数として計算するという基数変換をそのまま反映させました。(FromDigits
の懐の深さに感動!)
ただ、この方法だとJavaScriptなどの複素数をサポートしていない言語だとやりづらい、ということから代替法を考えました。
さっきの図で、数字のある座標を0から順に数えると、
$x(n): 0, 1, 1, 2, 0, 1, 1, 2, -2, -1, -1, 0,\dots$
$y(n): 0, 0, 1, 1, 2, 2, 3, 3, 2, 2, 3, 3,\dots$
となります。
中略で、
$x(2^n) = 1 - y(2^n-1)$
$y(2^n) = x(2^n-1)$
まで辿り着きました。
この式を使えば、例えば先頭16要素の$x$と$y$の組から
それに続く16要素の$x$と$y$の組を
簡単に求められるということになります。
Mathematicaでは以下のように書けました。
Graphics[Point[
Transpose[{Re[#], Im[#]} &[
Nest[Join[#, # + 1 - Im[Last[#]] + Re[Last[#]] I] &, {0}, 10]
]]
]]
ショートコード化
ショートコードというよりワンライナー化しただけですが、以下が完成形です。
(これまでのシリーズのショートコード、いずれ本気でコードゴルフしないと…。)
Graphics[Point[Transpose[{Re[#],Im[#]}&[Nest[Join[#,#+1-Im[Last[#]]+Re[Last[#]] I]&,{0},10]]]]]
Code submitted by @butchi_y #wolframlang Source: https://t.co/SviuRoKeYu pic.twitter.com/CwtRkbeLSQ
— Tweet-a-Program (@wolframtap) 2015, 12月 12
この解法により、JavaScriptでも簡潔に書けました。
アニメーションで描画しているので、デモをお楽しみください。
Twindragon - jsdo.it