2015年8月5日水曜日

数式お絵描き

Raspberry PiでMathematicaが使えるのはうれしい.

そのアナウンスにこうもりのような絵があった. もちろんMathematicaのPlot関数で描いたものだ.



その描画プログラムも添えてあったので, Mathematica屋の絵を描く方法が分るのではないかと期待してプログラムを解読した. とりあえずは目がくらくらするが,

である.

そもそもMathematicaで標準関数の絵を描くのは簡単だ. "Plot["と書き, 描くべき式を書き, ","で区切り, "{x,-Pi,Pi}"のように変数の範囲を書き, "]"で閉じる.
Plot[Sin[x],{x,-Pi,Pi}]


こうもりの絵のようなのは, 上の線と下の線を{,}で囲み区切ればよい.

Plot[{Sin[x],Cos[x]},{x,-Pi,Pi}]


こうもりプログラムでは, 1行目の"With"から10行目の"]]"までが上の曲線, 11行目から15行目の"2]"までが下の曲線である.

上の曲線のプログラムは"With[{"から w(3行目), l(2,3行目), h(4,5,6行目), r(7,8行目)を局所定義し(8行目の"},"で終る), それらを使い9,10行目の本体で描画する.

w(3*Sqrt[1-(x/7)^2])はこういう曲線だ.

これは要するに長軸(半径)7, 短軸1のx2/49+y2=1なる楕円の, 平方根は正をとるからその上半分を描いたわけである. あとから縦軸を3倍した.

次はl.(6/7)*Sqrt[10]+(3+x)/2-(3/7)*Sqrt[10]*Sqrt[4-(x+1)^2] のような形だ. 下に左右反対のrがある. xで変る項は(3+x)2とSqrt[4-(x+1)^2]で, 前者は斜線, 後者は例によって楕円である.

大きさを合せて合成するとこうなる. 上の図の斜線はxの範囲-7から7まであるが, 下の図では引くべき楕円が定義されている範囲が-3から1までなので, その外の 線は消えている.



4行目のhはこうもりの耳のところで, ( (1/2)*(3*(Abs[x-1/2]+Abs[x+1/2]+6)-11*(Abs[x-3/4]+Abs[x+3/4])))といろいろの斜線を組合せているに過ぎない.

ここまで準備したところで, 上の曲線は-7から-3,-3から-1,-1から1,1から3,3から7の区間をUnitStepで接続する. UnitStep[x]はx<0では0, 0≤xでは1になる関数で, UnitStep[x+3]とすると, -3から右が1になる.

w+(l-w)*UnitStep[x+3]+(h-l)*UnitStep[x+1]+(r-h)*UnitStep[x-1]+ (w-r)*UnitStep[x-3]]

x=-7では4個のどのUnitStepも0だから最初の項wで描きだす. x=-3になるとUnitStep[x+3]が1になり, それに(l-w)が掛るから, wが消えlの曲線を描き始める. x=-1 でlが終りhが始まる. x=1でrに, x=3で(w-r)があるので, rも終り, wが復活して最後を描く.


下の線もなかなか凝っているが, 全体的には上と同じ楕円に, 4個の楕円が組み合わさっている構造だ.
ここで一番主要な線はSqrt[1-(Abs[Abs[x]-2]-1)^2]だ.



すぐ上の図は左からAbs[x], Abs[x]-2, Abs[Abs[x]-2], Abs[Abs[x]-2]-1で, ここでそれぞれの斜線部分に対応して例の楕円が4個できる仕掛けである.



UnitStepの代わりにこちらではバンド幅フィルタのような関数でこの4個の楕円を取り出している. それが((x+4)/Abs[x+4]-(x-4)/Abs[x-4])で, 左がx<-4で-1, -4<xで1, 右がx<4で-1, 4<xで1だから, 結局x<-4で0, -4<x<4で2, 4<xで0という形が得られる.



これで4個の楕円を切り出しておき, それから最初と同じ楕円を引いて下の線が描ける.



勿論面倒なのでは区間の切れ目で位置を合わせることで, Sqrt[33]などはそういう計算の結果であろうが, プログラムの骨組みの説明では無視させて貰った. 面白かった.

0 件のコメント: