====================================
曲線 3 
====================================

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]
＊＊＊＊＊

与えられた曲線に対して、長さ d を一定にした法線を描いてみましょう。
この軌跡がオフセット曲線になります。

＊＊＊＊＊
normalline[alpha_][s_, t_] :=
  Line[{alpha[tt], alpha[tt] + 
s J[D[alpha[ tt], tt]]/(D[alpha[tt], tt].D[alpha[tt], tt])^(1/2)}] /. tt -> t
＊＊＊＊＊

まず楕円を考えましょう。

＊＊＊＊＊
ellipse[a_, b_][t_]:= {a* Cos[t], b* Sin[t]}
＊＊＊＊＊

＊＊＊＊＊
EllipNormalLines[a_, b_, d_] := Show[Graphics[{Thickness[0.001], 
     Evaluate[Table[normalline[ellipse[a, b]][d, t], {t, 0, 2*Pi, Pi/36}]]}], 
   ParametricPlot[Evaluate[ellipse[a, b][t]], {t, 0, 2*Pi}, 
    PlotStyle -> {Thickness[0.005], Red}, DisplayFunction -> Identity], 
   AspectRatio -> Automatic, DisplayFunction -> Identity, 
   PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
Show[ EllipNormalLines[3/2, 1, 1/1], AspectRatio -> Automatic, 
DisplayFunction -> $DisplayFunction]
＊＊＊＊＊

d をいろいろな値に変えてみてください。

次に楕円のオフセット曲線を描きましょう。
＊＊＊＊＊
ellipseoffset[a_, b_,d_]:=
ParametricPlot[Evaluate[offset[{a* Cos[t], b* Sin[t]},-d]], {t,0,2 Pi}, 
PlotStyle -> {Thickness[.005],Blue}, DisplayFunction -> Identity]
＊＊＊＊＊

＊＊＊＊＊
Show[ ellipseoffset[1.5, 1, 0.3], AspectRatio -> Automatic, 
DisplayFunction -> $DisplayFunction]
＊＊＊＊＊

長さ d を一定にした法線群（集まり）と比較してみましょう。
＊＊＊＊＊
Show[EllipNormalLines[1.5, 1, 0.3], ellipseoffset[1.5, 1, 0.3], 
DisplayFunction -> $DisplayFunction]
＊＊＊＊＊

d をいろいろな値に変えて変化を見てください。
(*  d=1/2, 0.7, 0.8, 1, 1.3, 1.5, 2 *) などと変えてみてください。


dの変化の様子をアニメーションにします。
＊＊＊＊＊
Table[
  Show[{
ParametricPlot[{1.5* Cos[t], 1* Sin[t]}, {t,0,2 Pi}, 
PlotStyle -> {Thickness[.005],Red}, DisplayFunction -> Identity],
ellipseoffset[1.5, 1, -d]}, 
 AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction,
 PlotRange -> {{-2, 2}, {-2.5, 2.5}}],
  {d, 0.1, 3.1, 0.05}];
＊＊＊＊＊

楕円の形を変えたとき、オフセット曲線はどう変わるかellipse[1.5, 1], ellipseoffset[1.5, 1, d]の 1.5, 1 を他の値に変えてアニメーションを作ってみてください。

次に 放物線を考えましょう。
＊＊＊＊＊
parabola[t_] := {t, t^2}
＊＊＊＊＊

放物線のオフセット曲線
＊＊＊＊＊
PARAB[d_] := Show[Graphics[{Thickness[0.001],  Evaluate[Table[normalline[parabola][d, t], {t, -1.5, 1.5, 1/20}]]}], 
ParametricPlot[Evaluate[parabola[t]], {t, -1.5, 1.5}, 
PlotStyle -> {Thickness[0.005], Red}, DisplayFunction -> Identity], 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, PlotRange -> All]
＊＊＊＊＊

d の値を変えてみてください。 (* d=0.2, 0.3, 0.5, 0.8, 1, 1,5, 2  *) など
＊＊＊＊＊
PARAB[0.9]
＊＊＊＊＊

＊＊＊＊＊
parabolaoffset[d_] := ParametricPlot[Evaluate[offset[{t, t^2}, -d]],
{t, -1.5, 1.5}, PlotStyle -> {Thickness[.005], Blue}, 
DisplayFunction -> Identity]
＊＊＊＊＊

＊＊＊＊＊
Show[ parabolaoffset[0.9], AspectRatio -> Automatic,
DisplayFunction -> $DisplayFunction]
＊＊＊＊＊

＊＊＊＊＊
Show[PARAB[0.9], parabolaoffset[0.9]]
＊＊＊＊＊


dの変化の様子をアニメーションにします。
＊＊＊＊＊
Table[Show[{ParametricPlot[Evaluate[parabola[t]], {t, -1.5, 1.5}, 
PlotStyle -> {Thickness[0.005], Red}, DisplayFunction -> Identity], 
 ParametricPlot[Evaluate[offset[{t, t^2}, -d]], {t, -1.5, 1.5}, 
PlotStyle -> {Thickness[0.006], Blue}, DisplayFunction -> Identity]}, 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, 
 PlotRange -> {{-1.5, 1.5}, {-2^(-1), 3}}], 
 {d, 0.1, 1.5, 0.05}];  
＊＊＊＊＊

次に y = x^4 に対して、どうなるかプログラムを作りましょう。
＊＊＊＊＊
curvedeg4[t_] := {t, t^4}

Normallinedeg4[d_] := Show[Graphics[{Thickness[0.001],  Evaluate[Table[normalline[curvedeg4][d, t], {t, -1.2, 1.2, 1/20}]]}], 
ParametricPlot[Evaluate[curvedeg4[t]], {t, -1.2, 1.2}, 
PlotStyle -> {Thickness[0.005], Red}, DisplayFunction -> Identity], 
AspectRatio -> Automatic, DisplayFunction -> $DisplayFunction, PlotRange -> All]
＊＊＊＊＊
このあとを作ってみましょう。
curvedeg4offset[d_] を同様に作ってください。


＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
つぎにいろいろな曲線を考えましょう。

＊＊＊＊＊
x[t_] := -t^2 + 1;
y[t_] := t^3 - t;
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]}, d], {x[t], y[t]}}],
 {t, -3, 3}, PlotRange -> {{-4, 4}, {-3, 3}}, 
AspectRatio -> Automatic, PlotStyle -> {Thickness[0.01], {}}],
{d, -1, 1, 0.05}];
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]}, d], offset[{x[t], y[t]}, -d], 
{x[t], y[t]}}], {t, -3, 3}, PlotRange -> {{-4, 4}, {-3, 3}}, 
AspectRatio -> Automatic, PlotStyle -> {Thickness[0.01], Thickness[0.01], {}}],
{d, -2, 2, 0.05}]
＊＊＊＊＊
＊＊＊＊＊


＊＊＊＊＊
(*cardioid*)
genex[t] = 1 - t^2;
geney[t] = 2 t;
genew[t] = (1 + t^2)^2;
x[t_] = genex[t]/genew[t];
y[t_] = geney[t]/genew[t];
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]}, 1/3], {offset[{x[t], y[t]},-3^(-1)], 
{x[t], y[t]}}], {t, -100, 100}, 
PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.007]}, 
{RGBColor[0, 0, 1], Thickness[0.007]}, {Thickness[0.007]}}, 
PlotPoints -> 100, AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]},1], offset[{x[t], y[t]},-1], 
{x[t], y[t]}}], {t, -100, 100}, 
PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.007]}, 
 {RGBColor[0, 0, 1], Thickness[0.007]}, {Thickness[0.007]}}, 
PlotPoints -> 100, AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},d], {x[t], y[t]}}], 
    {t, -100, 100}, PlotStyle -> 
     {{RGBColor[1, 0, 0], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 100, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-2, 2}, {-2, 2}}], {d, 0, 1, 0.02}]; 
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},-d], 
      {x[t], y[t]}}], {t, -100, 100}, 
    PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 100, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-2, 2}, {-2, 2}}], {d, 0, 1, 0.02}]; 
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},d], offset[{x[t], y[t]},-d], 
      {x[t], y[t]}}], {t, -100, 100}, 
    PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
      {RGBColor[0, 0, 1], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 160, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-2.5, 2.5}, {-2.5, 2.5}}], {d, 0, 1.6, 0.02}]; 
＊＊＊＊＊

＊＊＊＊＊
x[t_] = Simplify[((1 - t^2)/(1 + t^2))*ChebyshevT[2, (1 - t^2)/(1 + t^2)]]; 
y[t_] = Simplify[2*(t/(1 + t^2))*ChebyshevT[2,  (1 - t^2)/(1 + t^2)]]; 
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]},1/3], offset[{x[t], y[t]},-3^(-1)], 
    {x[t], y[t]}}], {t, -100, 100}, 
  PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
    {RGBColor[0, 0, 1], Thickness[0.005]}, 
    {Thickness[0.005]}}, PlotPoints -> 300, 
  AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]},1], offset[{x[t], y[t]},-1], 
    {x[t], y[t]}}], {t, -100, 100}, 
  PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
    {RGBColor[0, 0, 1], Thickness[0.005]}, 
    {Thickness[0.005]}}, PlotPoints -> 300, 
  AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},d], offset[{x[t], y[t]},-d], {x[t], y[t]}}], 
    {t, -100, 100}, PlotStyle -> 
     {{RGBColor[1, 0, 0], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 200, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-3, 3}, {-3, 3}}], {d, 0, 1, 0.02}]; 
＊＊＊＊＊

＊＊＊＊＊
x[t_] = Simplify[((1 - t^2)/(1 + t^2))*
     ChebyshevT[3, (1 - t^2)/(1 + t^2)]]; 
y[t_] = Simplify[2*(t/(1 + t^2))*ChebyshevT[3, 
      (1 - t^2)/(1 + t^2)]]; 
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{
  x[t], y[t]}, 1/3], offset[{x[t], y[t]}, -1/3], {x[t], y[t]}}], {t, -100, 100},
  PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
    {RGBColor[0, 0, 1], Thickness[0.005]}, 
    {Thickness[0.005]}}, PlotPoints -> 200, 
  AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]},1], offset[{x[t], y[t]},-1], 
    {x[t], y[t]}}], {t, 0, 100}, 
  PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
    {RGBColor[0, 0, 1], Thickness[0.005]}, 
    {Thickness[0.005]}}, PlotPoints -> 200, 
  AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},d], offset[{x[t], y[t]},-d], 
      {x[t], y[t]}}], {t, 0, 100}, PlotStyle -> 
     {{RGBColor[1, 0, 0], Thickness[0.005]}, 
      {RGBColor[0, 0, 1], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 200, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-3, 3}, {-3, 3}}], {d, 0, 2, 0.02}]; 
＊＊＊＊＊

＊＊＊＊＊
x[t_] = Simplify[((1 - t^2)*ChebyshevT[2, 
       (1 - t^2)/(1 + t^2)])/(1 + t^2)]; 
y[t_] = Simplify[(2*t*ChebyshevU[1, (1 - t^2)/(1 + t^2)]*
      (1 - t^2))/((1 + t^2)*(1 + t^2))]; 
＊＊＊＊＊

＊＊＊＊＊
ParametricPlot[Evaluate[{offset[{x[t], y[t]},1/3], offset[{x[t], y[t]},-3^(-1)], 
    {x[t], y[t]}}], {t, -100, 100}, 
  PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
    {RGBColor[0, 0, 1], Thickness[0.005]}, 
    {Thickness[0.005]}}, PlotPoints -> 300, 
  AspectRatio -> Automatic, PlotRange -> All]
＊＊＊＊＊

＊＊＊＊＊
Table[ParametricPlot[Evaluate[{offset[{x[t], y[t]},d], offset[{x[t], y[t]},-d], 
      {x[t], y[t]}}], {t, -100, 100}, 
    PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.005]}, 
      {RGBColor[0, 0, 1], Thickness[0.005]}, 
      {Thickness[0.005]}}, PlotPoints -> 300, 
    AspectRatio -> Automatic, PlotRange -> 
     {{-3, 3}, {-3, 3}}], {d, 0, 2, 0.02}]; 
＊＊＊＊＊


前回からの参考：

cos(nθ), sin(n + 1)θ を　cos(θ), (sin(θ) )の多項式として表す公式は
Chebyshev 多項式として知られています。これらの多項式は
mathematicaに組み込まれています。

例えば、ChebyshevT[2, c]は cos(2θ) を c=cos(θ)の多項式として表す式は
2c^2-1です。実際、次を試して下さい。

＊＊＊＊＊
ChebyshevT[2, c]
＊＊＊＊＊

ChebyshevT[n, c]は cos(nθ)をcos(θ)の多項式であらわすものです。

ChebyshevU[n, c]は sin[(n + 1)θ]/sin θ をcos(θ)の多項式であらわすものです

これを用いて、陰関数表示することを考えましょう。

＊＊＊＊＊
<< Graphics`ImplicitPlot`
＊＊＊＊＊

曲線
＊＊＊＊＊
ParametricPlot[{Cos[t]*Cos[2t], Sin[t]*Cos[2t]}, {t, 0, 2 Pi}, 
AspectRatio -> Automatic, 
PlotStyle -> {Thickness[.006], RGBColor[0.0, 0.0, 1.0]}]
＊＊＊＊＊
を考えます。

＊＊＊＊＊
f=Numerator[Factor[(c*(2 c^2-1)-x)/.{c->(1-t^2)/(1+t^2)}]]

g=Numerator[Factor[(s*(
    2 c^2-1)-y)/.{c->(1-t^2)/(1+t^2), s-> 2 t/(1+t^2)}]]

QQ=Factor[Resultant[f,g,t]]
＊＊＊＊＊

＊＊＊＊＊
ImplicitPlot[QQ == 0, {x, -1.1, 1.1}, {y, -1.1, 1.1}, PlotPoints -> 200, 
PlotStyle -> {  Thickness[.006], RGBColor[1.0, 0.0, 0.0]}]
＊＊＊＊＊


その他の例でもおなじことを試して下さい。陰関数表示を求めて下さい。