====================================
曲線 4 
====================================

Mathematicaを用いた練習を行います。

まず、Mathematica を使えるようにしてください。

プログラムの中の数字などを適当に変更してプログラムがうまく動くか試してみてください。

以下の説明の中で＊＊＊＊＊ではさまれた部分は
Mathematica に入力する文字列です。

コピーするか、自分で入力して、
Shift+Enter(Return) キーで実行します。

上から順に，すべて実行するようにしてください。
上で定義した関数を後で利用すること 
があります。
-----------------------------------

前回の続きです。

関数のグラフを描くにはPlotを用います。
曲線を描くには、ParametricPlot も用います。
これは、y=f(x)の形になるもの以外も描く必要があるためです。
また、色をつけるためにパッケージ　Graphics`Colors`　を
使います。

平面曲線を描くための準備として、まず次ぎを入力してください。

＊＊＊＊＊
<< Graphics`Colors`
J[{p1_, p2_}] := {-p2, p1}

(*  平面曲線の曲率   *)
kappa2[alpha_][t_] :=
  D[alpha[tt], {tt, 2}].J[D[alpha[tt], tt]]/
      Simplify[D[alpha[tt], tt].D[alpha[tt], tt]]^(3/2) /. tt -> t

alpha[t_] := {x[t], y[t]} 
＊＊＊＊＊

オフセット曲線、または、等距離曲線
与えられた曲線のオフセット曲線を定義しましょう。

つぎのような警告が出るかもしれませんが、かまわず続けてください。

(* 「General::"spell1" :
スペル間違いの可能性があります．新規シンボル"normal"はすでにあるシンボル
"Normal"に似ています．」 *)

＊＊＊＊＊
normal[{x_, y_}, t_] := 
{ D[y, t]/(D[x, t]^2 + D[y, t]^2)^(1/2), 
-D[x, t]/(D[x, t]^2 + D[y, t]^2)^(1/2) }
＊＊＊＊＊
オフセット曲線の定義
＊＊＊＊＊
offset[{x_, y_}, d_] := {x, y} + d normal[{x, y}, t]
＊＊＊＊＊

evolute (縮閉) 曲線の定義
＊＊＊＊＊
evolute[alpha_][t_]:= alpha[tt] + 
D[alpha[tt], tt].D[alpha[tt], tt]/(D[alpha[tt], {tt, 2} ].J[D[alpha[tt], tt]]) J[D[alpha[tt], tt]]/. tt -> t
＊＊＊＊＊

y = x^4 のオフセット曲線を描きましょう。
＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{t, 
      t^4}, d], {t, t^4}}], {t, -1.4, 1.4}, PlotRange -> {{-1.5, 
          1.5}, {-0.5, 2.5}}, AspectRatio -> Automatic, 
        PlotStyle -> {{RGBColor[1, 0, 0], 
        Thickness[0.007]}, {RGBColor[0, 0, 1], Thickness[0.007]}}, PlotPoints -> 100],
 {d, -0.05, -1.5, -0.01} ];
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{t, t^4}, -1], {
    t, t^4}}], {t, -1.4, 1.4}, PlotRange -> {{-1.5, 1.5}, {-0.5, 2.5}},
   AspectRatio -> Automatic, PlotStyle -> {{RGBColor[1, 0, 0],
     Thickness[0.0075]}, {RGBColor[0, 0, 1], Thickness[0.007]}}, PlotPoints -> 100]
＊＊＊＊＊
＊＊＊＊＊
 alpha[t_]:={t, t^4} 
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{{t, t^4}, evolute[alpha][t]}], {
        t, -1.4, 1.4}, PlotRange -> {{-1.5, 1.5}, {-0.5, 2.5}},
   AspectRatio -> Automatic]
＊＊＊＊＊

evolute曲線とオフセット曲線の特異点との関係を見よう。
＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{t, t^4}, d], {t, t^4}, evolute[alpha][t]}], 
{t, -1.4, 1.4}, PlotRange -> {{-1.5, 1.5}, {-0.5, 2.5}}, 
AspectRatio -> Automatic, 
PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.007]}, {RGBColor[0, 0, 1], Thickness[0.007]}, 
{Thickness[0.007]}},  PlotPoints -> 100], {d, -0.05, -1.5, -0.01} ];
＊＊＊＊＊


 beta[t_]:={t, t^2} 
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{{t, t^2}, evolute[beta][t]}], 
{t, -2, 2}, PlotRange -> {{-1.8, 1.8}, {-0.5, 3.5}}, 
PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.007]}, {Thickness[0.007]}}, 
AspectRatio -> Automatic ]
＊＊＊＊＊

evolute曲線とオフセット曲線の特異点との関係を見よう。
＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{t, t^2}, d], {t, t^2}, evolute[beta][t]}], 
{t, -2, 2}, PlotRange -> {{-2, 2}, {-0.5, 3}}, AspectRatio -> Automatic, 
PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.007]}, {RGBColor[0, 0, 1], Thickness[0.007]}, 
{Thickness[0.007]}}, PlotPoints -> 100], {d, -0.05, -3, -0.02}];
＊＊＊＊＊

楕円の場合
＊＊＊＊＊
ellip[a_, b_][t_]:= {a* Cos[t], b* Sin[t]}
＊＊＊＊＊
＊＊＊＊＊
Table[Show[
{ParametricPlot[Evaluate[{offset[ellip[1.5,1][t], d], 
ellip[1.5, 1][t], evolute[ellip[1.5, 1]][t]}], {t, 0, 2  Pi}, 
PlotStyle -> {{Thickness[.005], Blue}, {Thickness[.005], Red}, {Thickness[.005]}},
 DisplayFunction -> Identity]},
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
 PlotRange -> {{-2, 2}, {-2.0, 2.0}}],
 {d, -0.1, -2.8, -0.02}];
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

いろいろな曲線の場合を考えましょう。

＊＊＊＊＊
(* cardioid の場合 *)
cardioid[a_][t_]:= {2 a Cos[t]*(1+ Cos[t]), 2 a Sin[t]*((1+ Cos[t]))}
＊＊＊＊＊
＊＊＊＊＊
Table[Show[{
    ParametricPlot[Evaluate[{offset[cardioid[1][t], d], cardioid[1][t], evolute[cardioid[1]][t]}], 
{t, 0, 2 Pi}, PlotStyle -> {{Thickness[.005], Blue}, {Thickness[.005], Red}, {Thickness[.005]}}, 
DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-2, 4.5}, {-3.0, 3.0}}], {d, -0.1, -3, -0.02}];
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
    ParametricPlot[Evaluate[{offset[cardioid[1][t], -d], 
offset[cardioid[1][t], d], cardioid[1][t], evolute[cardioid[1]][t]}], 
{t, 0, 2 Pi}, PlotStyle -> {{Thickness[.005], Blue}, 
{Thickness[.005], Red}, {Thickness[.005]}}, 
DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-6, 8}, {-6.0, 6.0}}], {d, 0.1, 3.2, 0.02}];
＊＊＊＊＊

＊＊＊＊＊
rose2[t_] := {Cos[t]*Cos[2 t], Sin[t]*Cos[2 t]}
＊＊＊＊＊

＊＊＊＊＊
evolute[rose2][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[rose2[t], -d], offset[rose2[t], d], rose2[t], evolute[rose2][t]}], 
{t, 0, 2 Pi}, PlotStyle -> {{Thickness[.005],  Blue}, {Thickness[.005], Red}, {Thickness[.005]}, 
{Thickness[.005], Green}},  DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, PlotRange -> {{-2, 2}, {-2, 2}}],
    {d, 0.1, 1.2, 0.01}];
＊＊＊＊＊

＊＊＊＊＊
rose12[t_] := {Cos[t]*Cos[1/2 t], Sin[t]*Cos[1/2 t]}
＊＊＊＊＊

＊＊＊＊＊
evolute[rose12][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{ 
ParametricPlot[Evaluate[{offset[rose12[t], -d], rose12[t], 
 evolute[rose12][t]}], {t, 0, 4 Pi}, 
PlotStyle -> {{Thickness[.005], 
 Blue}, {Thickness[.005]}, {Thickness[.005], Red}}, 
DisplayFunction -> Identity]}, AspectRatio -> Automatic, 
DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}}], {d, 0.1, 1.0, 0.01}];
＊＊＊＊＊

＊＊＊＊＊
rose13[t_] := {Cos[t]*Cos[1/3 t], Sin[t]*Cos[1/3 t]}
＊＊＊＊＊

＊＊＊＊＊
evolute[rose13][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[rose13[t], -d], rose13[t], 
evolute[rose13][t]}], {t, 0, 3 Pi}, 
PlotStyle -> {{Thickness[.005], Blue}, 
{Thickness[.005]}, {Thickness[.005], Red}}, DisplayFunction -> Identity]}, AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}}], {d, 0.1, 1.06, 0.01}];
＊＊＊＊＊

＊＊＊＊＊
rose15[t_] := {Cos[t]*Cos[1/5 t], Sin[t]*Cos[1/5 t]}＊＊＊＊＊

＊＊＊＊＊
evolute[rose15][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[rose15[t], -d], rose15[t], 
evolute[rose15][t]}], {t, 0, 5 Pi}, 
PlotStyle -> {{Thickness[.005], Blue}, 
{Thickness[.005]}, {Thickness[.005], Red}}, DisplayFunction -> Identity]}, AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}}],{d, 0.1, 1.2, 0.01}];
＊＊＊＊＊

＊＊＊＊＊
rose14[t_] := {Cos[t]*Cos[1/4 t], Sin[t]*Cos[1/4 t]}＊＊＊＊＊

＊＊＊＊＊
evolute[rose14][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[rose14[t], -d], rose14[t], 
evolute[rose14][t]}], {t, 0, 8 Pi}, 
PlotStyle -> {{Thickness[.005], Blue}, 
{Thickness[.005]}, {Thickness[.005], Red}}, DisplayFunction -> Identity]}, AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}}],{d, 0.1, 1.04, 0.01}];
＊＊＊＊＊


(* sin x の場合を考えて見よう。 *)
＊＊＊＊＊
ss[t_] := {t, Sin[t]}
＊＊＊＊＊

＊＊＊＊＊
evolute[ss][t]
＊＊＊＊＊

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[ss[t], d],ss[t], evolute[ss][t]}], 
{t, 0 + 0.001, Pi - 0.0001}, 
PlotStyle -> {{Thickness[.005], Blue}, {Thickness[.005]}, 
{Thickness[.005], Red}}, DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{0 + 0.0001, Pi - 0.0001}, {-2, 1.5}}],
{d, 0.1, 3.0, 0.05}];
＊＊＊＊＊

(* cosh x の場合を考えて見よう。 *)
＊＊＊＊＊
ch[t_] := {t, Cosh[t]}
＊＊＊＊＊

evolute[ch][t]

＊＊＊＊＊
Table[Show[{
ParametricPlot[Evaluate[{offset[ch[t], -d], ch[t], evolute[ch][t]}], 
{t, -3, 3}, PlotStyle -> {{Thickness[.005], Blue}, {Thickness[.005]}, {Thickness[.005], Red}}, DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
PlotRange -> {{-3, 3}, {0, 5}}],
{d, 0.1, 3.0, 0.05}];
＊＊＊＊＊

＊＊＊＊＊

 
＊＊＊＊＊