GeoGebraでピタゴラスツリー

本記事は、下記ツイートに触発されて、「ピタゴラスツリー」をGeoGebraで作成した際の記録である。

ピタゴラスの定理により、各色の面積はずっと同じです。 pic.twitter.com/GY2RueVXcG

— ζWalker (@walker0226) May 15, 2021

 なお、本記事で解説する作成方法には、オリジナルツール「拡張Dilate / AffineRatio」の使用が含まれる。これについては、下記記事を参照されたい。

usidesu.hatenablog.com

サンプルアプレット

※（ご注意）下記アプレットの「num」スライダーを大きな値にすればするほど、処理が重くなり、端末に負荷がかかります。

ピタゴラスツリー_単純定義版 – GeoGebra

ステップ1　各種の前提オブジェクトの用意

ratio：0〜1のスライダー（正方形の大きさの比率をコントロールするための値）

ratio = Slider(0, 1, 0.0001, 1, 100, false, true, false, false)

num：任意の非負整数（演算回数を表す。大きすぎるとソフトがクラッシュする。環境にもよるが、最初は、2か3くらいにしておいた方が良いだろう。筆者の環境では、9が限界であった。）

num = Slider(0, 9, 1, 1, 100, false, true, false, false)

Start1, Start2：任意の点オブジェクト。最初の正方形の2頂点として用いる。

Start1 = (1,1)

Start2 =(4,2) 

ステップ2　ピタゴラスツリーを単一のリストオブジェクトとして作成してみる

IterationList[Flatten[Zip[{Polygon(Element({Vertex(ω)}, 4), Point(Semicircle(Element({Vertex(ω)}, 4), Element({Vertex(ω)}, 3)), 1 - ratio), 4),Polygon(Point(Semicircle(Element({Vertex(ω)}, 4), Element({Vertex(ω)}, 3)), 1 - ratio), Element({Vertex(ω)}, 3), 4)},ω,α]], α, {{polygon[Start1,Start2,4]}}, num]

上記数式で、上図のようなツリーが描ける（num=5, ratio=0.46の場合）。

これでも一応完成だが、演算回数ごとに色分けしたいし、非常に重たい。

そこで、以下では、色分け対応と、軽量化を試みた。

ステップ3　Polygon[<点>, <点>, 4]の引数として用いる点のリストを、できるだけ単純な計算で定義する

Flatten[IterationList(Flatten(Sequence({Element(α, k) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Point(Semicircle(Element(α, k), Element(α, k + 1)), 1 - ratio) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Point(Semicircle(Element(α, k), Element(α, k + 1)), 1 - ratio) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Element(α, k + 1) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k)))}, k, 1, Length(α) - 1, 2)), α, {{Start1, Start2}}, num)]

こちらの数式は、（アプレット軽量化のため）入力バーには入力しない。

ステップ4　ステップ3の点リストを用いて、各点の拡張AffineRatioのデータを、独立オブジェクトとして取得する

data=CopyFreeObject[Zip[ExtendedAffineRatio[Start1, Start2,ω],ω,Flatten[IterationList(Flatten(Sequence({Element(α, k) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Point(Semicircle(Element(α, k), Element(α, k + 1)), 1 - ratio) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Point(Semicircle(Element(α, k), Element(α, k + 1)), 1 - ratio) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k))), Element(α, k + 1) + ({{0, -1}, {1, 0}} (Element(α, k + 1) - Element(α, k)))}, k, 1, Length(α) - 1, 2)), α, {{Start1, Start2}}, num)]]]

この数式は、入力バーに打ち込むほか、ratioやnumのOn Updateスクリプトとしても記述しておく。

dataの値さえ取得できれば、あとからStart1, Start2, 拡張Dilateコマンドを用いることにより、Polygon[<点>, <点>, 4]の引数として用いる点リストに復号でき、しかもそれは点Start1, Start2の座標変化に連動する。

ステップ5　dataを復号する

followers=Zip[ExtendedDilate[Start2,x(ε),y(ε),Start1],ε,data]

ステップ6　followersを、色分けするグループごとに分類したリストを作成する

followersGrouped=Sequence[Sequence[{Element[followers,γ],Element[followers,γ+1]},γ,2^δ-1,2^δ-1+2*(2^(δ-1)-1),2],δ,1,num+1]

ステップ7　グループごとに正方形リストを作成する

Zip(Polygon(Element(k, 1), Element(k, 2), 4), k, Element[followersGrouped,★])

ただし、★には、1〜(num+1)の自然数を入れる。

これによって作成したnum+1個のリストオブジェクトに、それぞれ適宜色を設定する。

各リストオブジェクトの名前がl1, l2, ..., l10の場合、以下のスクリプトで色を塗れる。

SetColor( l1, 193/255, 0, 0 )
SetColor( l2, 252/255, 0, 0 )
SetColor( l3, 255/255, 192/255, 37/255 )
SetColor( l4, 255/255, 255/255, 53/255 )
SetColor( l5, 146/255, 209/255, 88/255 )
SetColor( l6, 0, 175/255, 86/255 )
SetColor( l7, 0, 177/255, 240/255 )
SetColor( l8, 0, 113/255, 191/255 )
SetColor( l9, 0, 34/255, 93/255 )
SetColor( l10, 113/255, 48/255, 152/255 )

以上の操作により、下図のような描画結果を得る（図はnum=9,ratio=0.35）。