任意の２次曲線の媒介変数表示を求めます。媒介変数を用いることで、色々な表現が可能になります。
今回は、曲線上の点を動かせるようにしました。Mathematica のファイルは Wolfram Player （無償）を用いてインタラクティブに操作できます。
行列 A, F および定数 c を変えることにより、任意の行列（放物線は未対応）について実行可能です。
概要☟
上 双曲線の場合
下 楕円 の場合。 手計算ですと、お手上げです。
任意の２次曲線の媒介変数表示を求めます。媒介変数を用いることで、色々な表現が可能になります。
今回は、曲線上の点を動かせるようにしました。Mathematica のファイルは Wolfram Player （無償）を用いてインタラクティブに操作できます。
行列 A, F および定数 c を変えることにより、任意の行列（放物線は未対応）について実行可能です。
概要☟
上 双曲線の場合
下 楕円 の場合。 手計算ですと、お手上げです。
|
|
    
|
コメントをお書きください
math (火曜日, 17 11月 2020 12:17)
(* 媒介変数表示 拝見致しました*)
(* ↓の q=0 は 楕円の証明です.
Normal[CoefficientArrays[q,{x,y},Symmetric->True][[3]]]
は ●もっと 高次でも 有用 ● で 屡 愛用しております
どうぞ お使いください*)
q = -972 + 216*x + 63 *x^2 + 144 *y + 30*x*y + 19*y^2
m = Normal[CoefficientArrays[q, {x, y}, Symmetric -> True][[3]]]
% // MatrixForm
Eigensystem[m]
N[%, 9]
%%[[2]]
%[[1]].%[[2]] // Simplify
0 == % // FullSimplify
(*これで 楕円であることが 証明された ので
媒介変数表示は 実に容易で
例えば {(3 (128 t^2+1996 t+5297))/(112 t^2+1268 t+4639),
-((9 (32 \t^2+1060 t+5375))/(112 t^2+1268 t+4639))}
と 瞬時に 叶う *)
para = ParametricPlot[{\!\(TraditionalForm\`{
\*FractionBox[\(3\ \((128\
\*SuperscriptBox[\(t\), \(2\)] + 1996\ t + 5297)\)\), \(112\
\*SuperscriptBox[\(t\), \(2\)] + 1268\ t + 4639\)], \(-
\*FractionBox[\(9\ \((32\
\*SuperscriptBox[\(t\), \(2\)] + 1060\ t + 5375)\)\), \(112\
\*SuperscriptBox[\(t\), \(2\)] + 1268\ t + 4639\)]\)}\)}, {t, -6 - 19,
7 + 2}, PlotStyle -> {{Thickness[0.012], RGBColor[1, 0, 0]}}]
X0 = 19;
-972 + 216 x + 63 x^2 + 144 y + 30 x y + 19 y^2
touisen =
ContourPlot[%, {x, -X0, X0}, {y, -X0, X0}, AspectRatio -> Automatic,
PlotRange -> All]
-972 + 216 x + 63 x^2 + 144 y + 30 x y + 19 y^2
daen = ContourPlot[% == 0, {x, -X0, X0}, {y, -X0, X0},
AspectRatio -> Automatic, PlotRange -> All]
Show[para, daen, PlotRange -> All]
(*F[t]=((3 (128 t^2+1996 t+5297))/(112 t^2+1268 t+4639),-((9 (32 \
t^2+1060 t+5375))/(112 t^2+1268 t+4639))) なる FのRの像を求め
F(R)⊂C[楕円] であり 全射 = ではないことを 証明願います;*)
小林 (木曜日, 19 11月 2020 18:26)
math 様
CoefficientArrays 教えていただき、ありがとうございます。
媒介変数は、どうやってだされたのか、不明ですが、lim の極限あたりが欠けていそうですね。
ブログはもう少し、今の話題の深化＋放物線の場合もカバー させたいです。
２次曲線から抜け出せません。
math (土曜日, 21 11月 2020 23:00)
(*>２次曲線から抜け出せません。
非線型写像 F を ↓ に 定義する。
F(x,y)=((16 x^3-27 x^2-2 x)/(-16 x^4+27 x^3+2 x^2+y),
-(1/(-16 x^4+27 x^3+2 x^2+y)))
二次曲線から 脱出する きっかけぐらいは つくってアゲル [と 中森明菜 少女A]
Fによる 2次の倍返しの4次曲線 C; -10+x^2+9 x^3-4 x^4+y==0 の像 F(C) を 多様な発想で 求め
其の [2重点なる] 特異点 (x0,y0) を 求め
{x0,y0}.{x,y}+1==0 が
C の二重接線となることを 立証し、
↓の 異国の人々 の 解法達 と 比較し
↑の手法を 愛し 今後常用してください!^(2020)
https://mathematica.stackexchange.com/questions/110668/how-to-find-a-tangent-line-with-2-points-of-tangency-for-a-curve
----------------------------------------*)
f1[x_] := 4 x^4 - 9 x^3 - x^2 + 10;
expr = Series[f1[x], {x, a, 1}] // Normal;
sols = DeleteDuplicates@SolveAlways[expr == (expr /. a -> b), x];
Plot[{f1[x], expr /. #}, {x, -1, 2}] & /@ Thread[a -> (a /. sols)]
tangent[a_, x_] := f1[a] + f1'[a] (x - a)
slope[a_] = Coefficient[tangent[a, x], x]
intercept[a_] = Coefficient[tangent[a, x], x, 0]
(*Then we want to find two distinct points a
a
and b
b
which have the same tangent line:*)sln =
Simplify@Solve[{slope[a] == slope[b], intercept[a] == intercept[b],
b > a}, {a, b}]
{{a -> 1/16 (9 - 5 Sqrt[11]), b -> 1/16 (9 + 5 Sqrt[11])}}
(*There is one solution.*)
pl = Plot[{f1[x], tangent[a, x] /. sln}, {x, -1, 2}]
(*etc*)